- 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 Feb 18, 2025@23:38:53 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
