- PSGOE42 ;BIR/CML3-REGULAR ORDER ENTRY (CONT.) ;09 JAN 97 / 9:25 AM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;
- ;
- 1 ; provider
- I $S(+PSJSYSU=3:0,1:$P(PSJSYSU,";",2)) G:$P(PSJSYSW0,"^",24) 5 G DONE
- A1 W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
- I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?",PSGF2=1 D ENHLP^PSGOEM(53.1,1) G 1
- I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$D(^VA(200,PSGPR,"PS")) W " "_$P(^("PS"),"^",2)_" "_$P(^("PS"),"^",3) S PSGFOK(1)="" G 5
- S PSGF2=1 I X?1."?" D ENHLP^PSGOEM(53.1,1)
- I $E(X)="^" D FF G:Y>0 @Y G 1
- K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)" D ^DIC K DIC I Y'>0 G 1
- S PSGPR=+Y,PSGPRN=$P(Y(0,0),"^"),PSGFOK(1)=""
- ;
- 5 ; self med
- I '$P(PSJSYSW0,"^",24) G DONE
- A5 W !,"SELF MED: " W:PSGSM]"" $P("NO^YES","^",PSGSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
- I "01"[X,$L(X)<2 S:PSGSM=""&(X]"") PSGSM=X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G DONE
- I X="@" W:PSGSM="" $C(7)," ??" G:PSGSM="" A5 D DEL G:%'=1 A5 S (PSGSM,PSGHSM)="" G DONE
- S PSGF2=5 I X?1"^".E D FF G:Y>0 @Y G A5
- I X?1."?" S PSGF2=5 D ENHLP^PSGOEM(53.1,5) G A5
- D YN I S PSGSM=$E(X)="Y",PSGFOK(5)="" G 6:PSGSM,DONE
- W $C(7) D ENHLP^PSGOEM(53.1,5) G A5
- ;
- 6 ; hospital supplied self med
- W !,"HOSPITAL SUPPLIED SELF MED: " W:PSGHSM]"" $P("NO^YES","^",PSGHSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
- I "01"[X,$L(X)<2 S:PSGHSM=""&(X]"") PSGHSM=X W:PSGHSM]"" " (",$P("NO^YES","^",PSGHSM+1),")" G DONE
- I X="@" W:PSGHSM="" $C(7)," ??" G:PSGHSM="" 6 D DEL G:%'=1 6 S PSGHSM="" G DONE
- S PSGF2=6 I X?1"^".E D FF G:Y>0 @Y G 6
- I X?1."?" D ENHLP^PSGOEM(53.1,6) G 6
- D YN I S PSGHSM=$E(X)="Y" G DONE
- W $C(7) S PSGF2=6 D ENHLP^PSGOEM(53.1,6) G 6
- Q
- ;
- DONE ;
- K F,F0,F1,PSGF2,F3,PSG,SDT Q
- ;
- FF ; up-arrow to another field
- D ENFF^PSGOEM I Y>0,Y'=1,Y'=5 S Y=Y_"^PSGOE4"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:1)
- Q
- ;
- DEL ; delete entry
- W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
- Q
- ;
- YN ; yes/no as a set of codes
- I X'?.U F Y=1:1:$L(X) I $E(X,Y)?1L S X=$E(X,1,Y-1)_$C($A(X,Y)-32)_$E(X,Y+1,$L(X))
- F Y="NO","YES" I $P(Y,X)="" W $P(Y,X,2) Q
- Q
- ;
- 2 ; dispense drug multiple
- I PSGDRG,'$D(^PS(53.45,PSJSYSP,2)) S ^(2,0)="^53.4502P^1^1",^(1,0)=PSGDRG_"^"_PSGUD
- K DA,DR S DIE="^PS(53.45,",DA=PSJSYSP,DR=2,DR(2,53.4502)=$S($G(PSGFOK(13)):.02,1:".01;.02") D ^DIE
- I '$O(^PS(53.45,PSJSYSP,2,0)) W $C(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!"
- I $G(PSGFOK(13)) Q
- G @FB
- PSGOE42 ;BIR/CML3-REGULAR ORDER ENTRY (CONT.) ;09 JAN 97 / 9:25 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;
- +3 ;
- 1 ; provider
- +1 IF $SELECT(+PSJSYSU=3:0,1:$PIECE(PSJSYSU,";",2))
- IF $PIECE(PSJSYSW0,"^",24)
- GOTO 5
- GOTO DONE
- A1 WRITE !,"PROVIDER: ",$SELECT(PSGPR:PSGPRN_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- IF '$TEST
- WRITE $CHAR(7)
- SET PSGOROE1=1
- GOTO DONE
- +1 IF $SELECT(X="":'PSGPR,1:X="@")
- WRITE $CHAR(7)," (Required)"
- SET X="?"
- SET PSGF2=1
- DO ENHLP^PSGOEM(53.1,1)
- GOTO 1
- +2 IF X=""
- IF PSGPR
- SET X=PSGPRN
- IF PSGPR'=PSGPRN
- IF $DATA(^VA(200,PSGPR,"PS"))
- WRITE " "_$PIECE(^("PS"),"^",2)_" "_$PIECE(^("PS"),"^",3)
- SET PSGFOK(1)=""
- GOTO 5
- +3 SET PSGF2=1
- IF X?1."?"
- DO ENHLP^PSGOEM(53.1,1)
- +4 IF $EXTRACT(X)="^"
- DO FF
- IF Y>0
- GOTO @Y
- GOTO 1
- +5 KILL DIC
- SET DIC="^VA(200,"
- SET DIC(0)="EMQZ"
- SET DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)"
- DO ^DIC
- KILL DIC
- IF Y'>0
- GOTO 1
- +6 SET PSGPR=+Y
- SET PSGPRN=$PIECE(Y(0,0),"^")
- SET PSGFOK(1)=""
- +7 ;
- 5 ; self med
- +1 IF '$PIECE(PSJSYSW0,"^",24)
- GOTO DONE
- A5 WRITE !,"SELF MED: "
- IF PSGSM]""
- WRITE $PIECE("NO^YES","^",PSGSM+1),"// "
- READ X:DTIME
- IF X="^"!'$TEST
- IF '$TEST
- WRITE $CHAR(7)
- SET PSGOROE1=1
- GOTO DONE
- +1 IF "01"[X
- IF $LENGTH(X)<2
- IF PSGSM=""&(X]"")
- SET PSGSM=X
- IF PSGSM]""
- WRITE " (",$PIECE("NO^YES","^",PSGSM+1),")"
- GOTO DONE
- +2 IF X="@"
- IF PSGSM=""
- WRITE $CHAR(7)," ??"
- IF PSGSM=""
- GOTO A5
- DO DEL
- IF %'=1
- GOTO A5
- SET (PSGSM,PSGHSM)=""
- GOTO DONE
- +3 SET PSGF2=5
- IF X?1"^".E
- DO FF
- IF Y>0
- GOTO @Y
- GOTO A5
- +4 IF X?1."?"
- SET PSGF2=5
- DO ENHLP^PSGOEM(53.1,5)
- GOTO A5
- +5 DO YN
- IF $TEST
- SET PSGSM=$EXTRACT(X)="Y"
- SET PSGFOK(5)=""
- IF PSGSM
- GOTO 6
- GOTO DONE
- +6 WRITE $CHAR(7)
- DO ENHLP^PSGOEM(53.1,5)
- GOTO A5
- +7 ;
- 6 ; hospital supplied self med
- +1 WRITE !,"HOSPITAL SUPPLIED SELF MED: "
- IF PSGHSM]""
- WRITE $PIECE("NO^YES","^",PSGHSM+1),"// "
- READ X:DTIME
- IF X="^"!'$TEST
- IF '$TEST
- WRITE $CHAR(7)
- SET PSGOROE1=1
- GOTO DONE
- +2 IF "01"[X
- IF $LENGTH(X)<2
- IF PSGHSM=""&(X]"")
- SET PSGHSM=X
- IF PSGHSM]""
- WRITE " (",$PIECE("NO^YES","^",PSGHSM+1),")"
- GOTO DONE
- +3 IF X="@"
- IF PSGHSM=""
- WRITE $CHAR(7)," ??"
- IF PSGHSM=""
- GOTO 6
- DO DEL
- IF %'=1
- GOTO 6
- SET PSGHSM=""
- GOTO DONE
- +4 SET PSGF2=6
- IF X?1"^".E
- DO FF
- IF Y>0
- GOTO @Y
- GOTO 6
- +5 IF X?1."?"
- DO ENHLP^PSGOEM(53.1,6)
- GOTO 6
- +6 DO YN
- IF $TEST
- SET PSGHSM=$EXTRACT(X)="Y"
- GOTO DONE
- +7 WRITE $CHAR(7)
- SET PSGF2=6
- DO ENHLP^PSGOEM(53.1,6)
- GOTO 6
- +8 QUIT
- +9 ;
- DONE ;
- +1 KILL F,F0,F1,PSGF2,F3,PSG,SDT
- QUIT
- +2 ;
- FF ; up-arrow to another field
- +1 DO ENFF^PSGOEM
- IF Y>0
- IF Y'=1
- IF Y'=5
- SET Y=Y_"^PSGOE4"_$SELECT("^109^13^3^7^26^"[("^"_Y_"^"):"",1:1)
- +2 QUIT
- +3 ;
- DEL ; delete entry
- +1 WRITE !?3,"SURE YOU WANT TO DELETE"
- SET %=0
- DO YN^DICN
- IF %'=1
- WRITE $CHAR(7)," <NOTHING DELETED>"
- +2 QUIT
- +3 ;
- YN ; yes/no as a set of codes
- +1 IF X'?.U
- FOR Y=1:1:$LENGTH(X)
- IF $EXTRACT(X,Y)?1L
- SET X=$EXTRACT(X,1,Y-1)_$CHAR($ASCII(X,Y)-32)_$EXTRACT(X,Y+1,$LENGTH(X))
- +2 FOR Y="NO","YES"
- IF $PIECE(Y,X)=""
- WRITE $PIECE(Y,X,2)
- QUIT
- +3 QUIT
- +4 ;
- 2 ; dispense drug multiple
- +1 IF PSGDRG
- IF '$DATA(^PS(53.45,PSJSYSP,2))
- SET ^(2,0)="^53.4502P^1^1"
- SET ^(1,0)=PSGDRG_"^"_PSGUD
- +2 KILL DA,DR
- SET DIE="^PS(53.45,"
- SET DA=PSJSYSP
- SET DR=2
- SET DR(2,53.4502)=$SELECT($GET(PSGFOK(13)):.02,1:".01;.02")
- DO ^DIE
- +3 IF '$ORDER(^PS(53.45,PSJSYSP,2,0))
- WRITE $CHAR(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!"
- +4 IF $GET(PSGFOK(13))
- QUIT
- +5 GOTO @FB
