- PSGOE31 ;BIR/CML3-ORDER ENTRY THROUGH OE/RR (CONT.) ;09 JAN 97 / 2:28 PM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;
- ;**************************************************
- ;*** As of 1/9/97 This routine is no longer use ***.
- ;**************************************************
- 1 ; provider
- G:$S($D(PSJOERR):1,+PSJSYSU=3:0,1:$P(PSJSYSU,";",2)) 5
- A1 W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
- S PSGF2=1 I $S(X="@":1,X="":'PSGPR,1:0) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,1) G A1
- 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:$P(PSJSYSW0,"^",24) 5 G DONE
- I X?1."?" D ENHLP^PSGOEM(53.1,1)
- I $E(X)="^" D FF G:Y>0 @Y G A1
- 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 A1
- S PSGPR=+Y,PSGPRN=$P(Y(0,0),"^"),PSGFOK(1)=""
- ;
- 5 ; self med
- I '$P(PSJSYSW0,"^",24) G 106:PSGOEORF,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:'PSGSM 106:PSGOEORF,DONE S PSGFOK(5)="" G 6
- S PSGF2=5 I X="@" W:PSGSM="" $C(7)," ??" G:PSGSM="" A5 D DEL G:%'=1 A5 S (PSGSM,PSGHSM)="" G 106:PSGOEORF,DONE
- I X?1"^".E D FF G:Y>0 @Y G A5
- I X?1."?" D ENHLP^PSGOEM(53.1,5) G A5
- D YN I S PSGSM=$E(X)="Y",PSGFOK(5)="" G 6:PSGSM,106:PSGOEORF,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 106:PSGOEORF,DONE
- I X="@" W:PSGHSM="" $C(7)," ??" G:PSGHSM="" 6 D DEL G:%'=1 6 S PSGHSM="" G 106:PSGOEORF,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 106:PSGOEORF,DONE
- W $C(7) D ENHLP^PSGOEM(53.1,6) G 6
- ;
- 106 ; nature of order
- W !,"This is an old nature of order call from ^PSGOE31.",!
- Q
- G:'PSGOEORF DONE I $S($D(PSJOERR):1,$P(PSJSYSU,";",2):1,1:'PSJSYSU) S PSGFOK(106)="" G DONE
- A106 W !!,"NATURE OF ORDER: ",PSJNOON,"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S:'$T X="^" S PSGOROE1=1 G DONE
- I X="" W:PSJNOON]"" " ",PSJNOON S PSGFOK(106)="" G DONE
- S PSGF2=106 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,106) G A106
- I $E(X)="^" D FF G:Y>0 @Y G A106
- F Y="W^WRITTEN","P^TELEPHONED","V^VERBAL" I $S(X=$P(Y,"^"):1,1:$P($P(Y,"^",2),X)="") W $S(X=$P(Y,"^"):" "_$P(Y,"^",2),1:$P($P(Y,"^",2),X,2)) S PSJNOO=$P(Y,"^"),PSJNOON=$P(Y,"^",2) Q
- E W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,106) G A106
- S PSGFOK(106)=""
- ;
- DONE ;
- I PSGOROE1 K Y W $C(7)," ...order not entered..."
- K F,F0,F1,PSGF2,F3,PSGFOK,PSGOROE1,PSGSD,SDT Q
- ;
- FF ; up-arrow to another field
- S Y=-1 I '$D(PSGFOK) W $C(7)," ??" Q
- S X=$E(X,2,99) I X=+X S Y=$S($D(PSGFOK(X)):X,1:-1) W " " W:Y>0 $P(^DD(53.1,X,0),"^") W:Y'>0 $C(7),"??" Q
- K DIC S DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I $D(PSGFOK(+Y))" D ^DIC K DIC S Y=+Y I Y>0 S:Y=2 FB=PSGF2 I Y'=1,Y'=2,Y'=5,Y'=6 S Y=Y_"^PSGOE3"
- Q
- ;
- DEL ;
- W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W " <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(53.4502,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!"
- G @FB
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOE31 3968 printed Feb 18, 2025@23:28:15 Page 2
- PSGOE31 ;BIR/CML3-ORDER ENTRY THROUGH OE/RR (CONT.) ;09 JAN 97 / 2:28 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;
- +3 ;**************************************************
- +4 ;*** As of 1/9/97 This routine is no longer use ***.
- +5 ;**************************************************
- 1 ; provider
- +1 if $SELECT($DATA(PSJOERR)
- GOTO 5
- A1 WRITE !,"PROVIDER: ",$SELECT(PSGPR:PSGPRN_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- if '$TEST
- WRITE $CHAR(7)
- SET PSGOROE1=1
- GOTO DONE
- +1 SET PSGF2=1
- IF $SELECT(X="@":1,X="":'PSGPR,1:0)
- WRITE $CHAR(7)," (Required)"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,1)
- GOTO A1
- +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)=""
- if $PIECE(PSJSYSW0,"^",24)
- GOTO 5
- GOTO DONE
- +3 IF X?1."?"
- DO ENHLP^PSGOEM(53.1,1)
- +4 IF $EXTRACT(X)="^"
- DO FF
- if Y>0
- GOTO @Y
- GOTO A1
- +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 A1
- +6 SET PSGPR=+Y
- SET PSGPRN=$PIECE(Y(0,0),"^")
- SET PSGFOK(1)=""
- +7 ;
- 5 ; self med
- +1 IF '$PIECE(PSJSYSW0,"^",24)
- if PSGOEORF
- GOTO 106
- 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),")"
- if 'PSGSM
- if PSGOEORF
- GOTO 106
- GOTO DONE
- SET PSGFOK(5)=""
- GOTO 6
- +2 SET PSGF2=5
- IF X="@"
- if PSGSM=""
- WRITE $CHAR(7)," ??"
- if PSGSM=""
- GOTO A5
- DO DEL
- if %'=1
- GOTO A5
- SET (PSGSM,PSGHSM)=""
- if PSGOEORF
- GOTO 106
- GOTO DONE
- +3 IF X?1"^".E
- DO FF
- if Y>0
- GOTO @Y
- GOTO A5
- +4 IF X?1."?"
- 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
- if PSGOEORF
- GOTO 106
- 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),")"
- if PSGOEORF
- GOTO 106
- GOTO DONE
- +3 IF X="@"
- if PSGHSM=""
- WRITE $CHAR(7)," ??"
- if PSGHSM=""
- GOTO 6
- DO DEL
- if %'=1
- GOTO 6
- SET PSGHSM=""
- if PSGOEORF
- GOTO 106
- 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"
- if PSGOEORF
- GOTO 106
- GOTO DONE
- +7 WRITE $CHAR(7)
- DO ENHLP^PSGOEM(53.1,6)
- GOTO 6
- +8 ;
- 106 ; nature of order
- +1 WRITE !,"This is an old nature of order call from ^PSGOE31.",!
- +2 QUIT
- +3 if 'PSGOEORF
- GOTO DONE
- IF $SELECT($DATA(PSJOERR):1,$PIECE(PSJSYSU,";",2):1,1:'PSJSYSU)
- SET PSGFOK(106)=""
- GOTO DONE
- A106 WRITE !!,"NATURE OF ORDER: ",PSJNOON,"// "
- READ X:DTIME
- IF X="^"!'$TEST
- if '$TEST
- WRITE $CHAR(7)
- if '$TEST
- SET X="^"
- SET PSGOROE1=1
- GOTO DONE
- +1 IF X=""
- if PSJNOON]""
- WRITE " ",PSJNOON
- SET PSGFOK(106)=""
- GOTO DONE
- +2 SET PSGF2=106
- IF X="@"!(X?1."?")
- if X="@"
- WRITE $CHAR(7)," (Required)"
- if X="@"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,106)
- GOTO A106
- +3 IF $EXTRACT(X)="^"
- DO FF
- if Y>0
- GOTO @Y
- GOTO A106
- +4 FOR Y="W^WRITTEN","P^TELEPHONED","V^VERBAL"
- IF $SELECT(X=$PIECE(Y,"^"):1,1:$PIECE($PIECE(Y,"^",2),X)="")
- WRITE $SELECT(X=$PIECE(Y,"^"):" "_$PIECE(Y,"^",2),1:$PIECE($PIECE(Y,"^",2),X,2))
- SET PSJNOO=$PIECE(Y,"^")
- SET PSJNOON=$PIECE(Y,"^",2)
- QUIT
- +5 IF '$TEST
- WRITE $CHAR(7)," ??"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,106)
- GOTO A106
- +6 SET PSGFOK(106)=""
- +7 ;
- DONE ;
- +1 IF PSGOROE1
- KILL Y
- WRITE $CHAR(7)," ...order not entered..."
- +2 KILL F,F0,F1,PSGF2,F3,PSGFOK,PSGOROE1,PSGSD,SDT
- QUIT
- +3 ;
- FF ; up-arrow to another field
- +1 SET Y=-1
- IF '$DATA(PSGFOK)
- WRITE $CHAR(7)," ??"
- QUIT
- +2 SET X=$EXTRACT(X,2,99)
- IF X=+X
- SET Y=$SELECT($DATA(PSGFOK(X)):X,1:-1)
- WRITE " "
- if Y>0
- WRITE $PIECE(^DD(53.1,X,0),"^")
- if Y'>0
- WRITE $CHAR(7),"??"
- QUIT
- +3 KILL DIC
- SET DIC="^DD(53.1,"
- SET DIC(0)="QEM"
- SET DIC("S")="I $D(PSGFOK(+Y))"
- DO ^DIC
- KILL DIC
- SET Y=+Y
- IF Y>0
- if Y=2
- SET FB=PSGF2
- IF Y'=1
- IF Y'=2
- IF Y'=5
- IF Y'=6
- SET Y=Y_"^PSGOE3"
- +4 QUIT
- +5 ;
- DEL ;
- +1 WRITE !?3,"SURE YOU WANT TO DELETE"
- SET %=0
- DO YN^DICN
- IF %'=1
- WRITE " <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(53.4502,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 GOTO @FB
