| REGPAT | ; Registration of Pat ient for MUMPS |
| ; Copyriqht 1986(C)by K.Kimra | |
| MSG | ; |
| ; 氏 名 ; ; | |
| ; 受診カード番号 ; ; | |
| ; 性 別 ; ; | |
| ; 生 年 月 日 ; ; | |
| ; コ メ ン ト ; ; | |
| ; | |
| FOR I=1:1:5 SET MSG(I)=$PIECE($TEXT(MSG+I),";",2) | |
| START | DO STINP IF SW=5 GOTO END |
| IF SW=-1 GOTO STAT | |
| IF SW'=0 DO @$PIECE("LIST/LIST/LISTNAM/LISTID","/",SW) GOTO START | |
| FOR I=2:1:5 DO INPUT | |
| DO DSKSET GOTO START | |
| END | WRITE !!,"*** END OF JOB ***" |
| QUIT | |
| ; | |
| STINP | WRITE !!,MSG(1) READ DATA |
| SET SW=$SELECT(DATA="+":3,DATA="*":4,DATA="/":5,1:0) | |
| IF SW'=0 GOTO STEND | |
| IF DATA?2N.E DO IDCHK GOTO STEND | |
| ELSE IF $DATA(^PREG(DATA)) SET SW=1 | |
| STEND | QUIT |
| IDCHK | SET SW=-1 |
| IF $DATA(^PID(DATA)) SET DATA=^PID(DATA),SW=2 | |
| QUIT | |
| ; | |
| INPUT | WRITE !,MSG(I) READ DATA(I) |
| QUIT | |
| ; | |
| DSKSET | SET INF=DATA(2) |
| FOR I=3:1:5 SET INF=INF_"!"_DATA(I) | |
| SET ^PREG(DATA)=INF,^PID(DATA(2))=DATA | |
| QUIT | |
| ; | |
| LISTNAM SET NAME="" WRITE! | |
| FOR J=0:0 SET NAME=$ORDER(^PREG(NAME)) QUIT:NAME="" DO DISP | |
| QUIT | |
DISP |
WRITE !,NAME,":",^PREG(NAME) |
| QUIT | |
| ; | |
| LISTID | SET ID="" WRITE ! |
| FOR J=0:0 SET ID=$ORDER(^PID(ID)) QUIT:ID="" SET NAME=^PID(ID) DO DISP | |
| QUIT | |