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 |