MCARDBL ;WISC/TJK-UTILITY TO ASTERIK OUT ENTRIES ON SCREEN AND FUNCTIONS ;5/2/96 12:54
;;2.3;Medicine;;09/13/1996
START Q:'$D(DJBLO) Q:DJBLO=""
F DJBNO=1:1 S DJBITEM=$P(DJBLO,",",DJBNO) Q:DJBITEM="" D
.Q:'$D(DJJ(DJBITEM)) S DJDB=""
.S $P(DJDB,"*",$P(DJJ(DJBITEM),U)+1)=""
.S @($P(DJJ(DJBITEM),U,2))
.K DJP1,DJP2,DJP8
.X XY W DJDB S DJBHOLD=DJJ(DJBITEM),DJBITEM1=DJBITEM K DJJ(DJBITEM),V(DJBITEM)
S DY=16,DX=15 X XY W DJHIN,"[Asterisks (*) indicate field n/a to this record] "
G EXIT:$D(DJJ(V))
S DJNX=$O(DJJ(V)) I DJNX="" S DY=17,DX=0 X XY W "Press <RETURN> to Continue" S V=DJBITEM1,DJJ(V)=DJBHOLD,DJNX=DJBITEM1,$P(DJJ(V),U,1,2)="2^DY=17,DX=27"
E S V=DJNX
EXIT K DJBLO,DJBNO,DJDB,DJBITEM,DJBITEM1,DJBHOLD
Q
FUNC ;Functions
;DCB-Function commands.
I X="^T",$D(DJTOGGLE) W IOKPNM K DJTOGGLE D HELP G R^MCARDNJ
I X="^T",'$D(DJTOGGLE) W IOKPAM S DJTOGGLE="" D HELP G R^MCARDNJ
I X="^C" D HELP1 G R^MCARDNJ
I X="^R" S DA=D0,DJNM=DJDPL,DJFLAG=V,MCMASS=1 K MCDID D ^MCARDPL D ^MCARD1 G EN^MCARDNJ
;I X="^K" S MCMASS=1 K MCDID D FUNCK^MCARDNQ2 G R^MCARDNJ
I X="^O",'$D(MCHELPSW) S MCHELPSW=0 K MCDID S MCMASS=1 G TK^MCARDNJ
I X="^O",$D(MCHELPSW) K MCHELPSW K MCDID S MCMASS=1 G TK^MCARDNJ
I X="^H" S MCHELPS2=1 D START^MCARDHLP K MCDID,MCHELPS2 S MCMASS=1 G R^MCARDNJ
G RETURN^MCARDNJ
HELP ;
Q:'$D(MCHELPSW)
HELP1 ;
I '$D(DJTOGGLE) D FUNCC^MCARDNQ2
E D FUNCK^MCARDNQ2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARDBL 1436 printed Apr 09, 2024@21:17:57 Page 2
MCARDBL ;WISC/TJK-UTILITY TO ASTERIK OUT ENTRIES ON SCREEN AND FUNCTIONS ;5/2/96 12:54
+1 ;;2.3;Medicine;;09/13/1996
START if '$DATA(DJBLO)
QUIT
if DJBLO=""
QUIT
+1 FOR DJBNO=1:1
SET DJBITEM=$PIECE(DJBLO,",",DJBNO)
if DJBITEM=""
QUIT
Begin DoDot:1
+2 if '$DATA(DJJ(DJBITEM))
QUIT
SET DJDB=""
+3 SET $PIECE(DJDB,"*",$PIECE(DJJ(DJBITEM),U)+1)=""
+4 SET @($PIECE(DJJ(DJBITEM),U,2))
+5 KILL DJP1,DJP2,DJP8
+6 XECUTE XY
WRITE DJDB
SET DJBHOLD=DJJ(DJBITEM)
SET DJBITEM1=DJBITEM
KILL DJJ(DJBITEM),V(DJBITEM)
End DoDot:1
+7 SET DY=16
SET DX=15
XECUTE XY
WRITE DJHIN,"[Asterisks (*) indicate field n/a to this record] "
+8 if $DATA(DJJ(V))
GOTO EXIT
+9 SET DJNX=$ORDER(DJJ(V))
IF DJNX=""
SET DY=17
SET DX=0
XECUTE XY
WRITE "Press <RETURN> to Continue"
SET V=DJBITEM1
SET DJJ(V)=DJBHOLD
SET DJNX=DJBITEM1
SET $PIECE(DJJ(V),U,1,2)="2^DY=17,DX=27"
+10 IF '$TEST
SET V=DJNX
EXIT KILL DJBLO,DJBNO,DJDB,DJBITEM,DJBITEM1,DJBHOLD
+1 QUIT
FUNC ;Functions
+1 ;DCB-Function commands.
+2 IF X="^T"
IF $DATA(DJTOGGLE)
WRITE IOKPNM
KILL DJTOGGLE
DO HELP
GOTO R^MCARDNJ
+3 IF X="^T"
IF '$DATA(DJTOGGLE)
WRITE IOKPAM
SET DJTOGGLE=""
DO HELP
GOTO R^MCARDNJ
+4 IF X="^C"
DO HELP1
GOTO R^MCARDNJ
+5 IF X="^R"
SET DA=D0
SET DJNM=DJDPL
SET DJFLAG=V
SET MCMASS=1
KILL MCDID
DO ^MCARDPL
DO ^MCARD1
GOTO EN^MCARDNJ
+6 ;I X="^K" S MCMASS=1 K MCDID D FUNCK^MCARDNQ2 G R^MCARDNJ
+7 IF X="^O"
IF '$DATA(MCHELPSW)
SET MCHELPSW=0
KILL MCDID
SET MCMASS=1
GOTO TK^MCARDNJ
+8 IF X="^O"
IF $DATA(MCHELPSW)
KILL MCHELPSW
KILL MCDID
SET MCMASS=1
GOTO TK^MCARDNJ
+9 IF X="^H"
SET MCHELPS2=1
DO START^MCARDHLP
KILL MCDID,MCHELPS2
SET MCMASS=1
GOTO R^MCARDNJ
+10 GOTO RETURN^MCARDNJ
HELP ;
+1 if '$DATA(MCHELPSW)
QUIT
HELP1 ;
+1 IF '$DATA(DJTOGGLE)
DO FUNCC^MCARDNQ2
+2 IF '$TEST
DO FUNCK^MCARDNQ2
+3 QUIT
