- PSIVQUI ;BIR/RGY,MLM-HANDLE QUICK CODE ENTRIES ;15 Dec 98 / 8:29 AM
- ;;5.0; INPATIENT MEDICATIONS ;**21,50,65,73,76,93,104,110**;16 DEC 97
- ;
- ;Reference to ^PS(51.1 is supported by DBIA 2177
- ;Reference to ^PS(51.2 is supported by DBIA 2178
- ;Reference to ^PS(52.6 is supported by DBIA 1231
- ;Reference to ^PS(52.7 is supported by DBIA 2173
- ;
- N X,PSIVSC1 S (PSIVAT,PSIVAAT,PSIVWAT)="",PSIVQUIY=Y,(X,PSIVQUIX)=PSIVX
- Q:'Y!(PSIVQUIX="") S PSIVX0=$O(^PS(52.6,"C",X,+Y,0)),PSIVX0=$G(^PS(52.6,+Y,1,PSIVX0,0))
- I $P(PSIVX0,"^",5)]""!$P(PSIVX0,"^",6)!(P(5)) S PSIVAAT=$P(PSIVX0,"^",6)
- K PSIVX0 S Y=PSIVQUIY,Y(0)=$G(^PS(52.6,+Y,0)),X=PSIVQUIX
- Q:$S('$D(X):1,'$D(^PS(52.6,"C",X)):1,1:0)!'$D(P(4))
- SET K DRG S PSIVX0=$S($D(^PS(52.6,+Y,1,+$O(^PS(52.6,"C",X,+Y,0)),0)):^(0),1:""),(DRGI,DRG("AD",0))=1,TDRG("AD",+Y,DRGI)="",DRG("AD",DRGI)=+Y_U_$P(Y(0),U)_U_$P(PSIVX0,"^",2)_U_U_$P(Y(0),U,13)_U_$P(Y(0),U,11)
- N PSIVQZ,PSIVADD0,PSIVSZ,PSIVAZ,PSIVXAT,PSIVSIEN,PSIVXW S PSIVSIEN=0
- I $P(PSIVX0,U,4)]"" S P("OPI")=$P(PSIVX0,U,4)
- I $P(PSIVX0,U,7)?1N.N D Q:$G(PSGORQF)
- . S ND=$G(^PS(52.7,$P(PSIVX0,U,7),0))
- . W !!,"SOLUTION: ",$P(ND,U),!
- . N FIL S FIL="52.7",DRGTMP=$P(PSIVX0,U,7) D ORDERCHK^PSIVEDRG(DFN,ON55,1)
- . I $G(PSGORQF) S X="^",DONE=1 Q
- . S DRG("SOL",0)=1,DRG("SOL",1)=$P(PSIVX0,U,7)_U_$P(ND,U)_U_$P(ND,U,3)_U_U_$P(ND,U,13)_U_$P(ND,U,11),TDRG("SOL",$P(PSIVX0,U,7),1)=""
- I $P(PSIVX0,U,5)]""!P(5) S X=$P(PSIVX0,U,5)
- S PSIVQZ=$P(PSIVX0,U,5),PSIVQAZ=$P(PSIVX0,U,6),PSIVADD0=$G(^PS(52.6,+PSIVQUIY,0)),X=PSIVQZ
- S PSIVSZ=$P(PSIVADD0,"^",5),PSIVAZ=$P(PSIVADD0,"^",6)
- S PSIVAAT=$S(PSIVQZ]""&(PSIVQAZ]""):PSIVQAZ,PSIVQZ=""&(PSIVSZ]""):PSIVAZ,PSIVQZ=PSIVSZ:PSIVAZ,1:"")
- I $P(PSIVX0,U,5)']""!P(5) S X=$S(X]"":X,1:$P($G(^PS(52.6,+PSIVQUIY,0)),"^",5))
- ;
- ; If a sched was found, check all matching schedules
- ; in 51.1 against $P(PSIVX0,"^",5), PSIVAAT, PSIVWAT
- I PSIVQZ]"",$G(X)'="" S ZZ=0 D
- .;if ZZ sched/times matches quick code sched/times, use the schedule
- .F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
- ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
- ..I PSIVXAT=$P(PSIVX0,"^",6) S PSIVAT=$P(PSIVX0,"^",6),PSIVSIEN=ZZ
- ;
- ; If quick code has no schedule, check IV additive
- I PSIVAT="",$P(PSIVX0,"^",5)="",$G(X)'="" S ZZ=0 D
- .F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
- ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
- ..I PSIVAAT=PSIVXAT,(X=PSIVSZ) S PSIVAT=PSIVAAT,PSIVSIEN=ZZ
- .I PSIVAT="",PSIVAAT]"" S PSIVAT=PSIVAAT,$P(PSIVX0,"^",6)=PSIVAAT,$P(PSIVX0,"^",5)=PSIVSZ,PSIVSIEN=-1
- ;
- ; If quick code has schedule, no admin times, use ward times
- I PSIVAT="",PSIVQZ]"",$G(X)'="" D
- .S PSIVXW=$S($G(WSCHADM):WSCHADM,$G(VAIN(4)):+VAIN(4),1:"") Q:'PSIVXW
- .S ZZ=0 F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
- ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
- ..S PSIVWAT=$P($G(^PS(51.1,ZZ,1,+PSIVXW,0)),"^",2)
- ..I PSIVWAT]"" S PSIVAT=PSIVWAT,PSIVSIEN=ZZ
- ;
- ; No ward times; go back to IV additive. If quick code has schedule,
- ; make sure it matches IV additive
- I PSIVAT="",PSIVAAT]"",PSIVWAT="",$G(X) D
- .S ZZ=0 F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
- ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
- ..I (PSIVQZ=X&(PSIVQZ=PSIVSZ))!(PSIVQZ=""&(PSIVSZ]"")) I PSIVXAT=PSIVAAT D Q
- ...S PSIVAT=PSIVAAT,PSIVSIEN=ZZ
- .I PSIVAT="" S PSIVAT=PSIVAAT,$P(PSIVX0,"^",6)=PSIVAAT,$P(PSIVX0,"^",5)=X,PSIVSIEN=-1
- I $G(PSIVSIEN) S Y=$S(PSIVSIEN>0:PSIVSIEN,1:"") N PSGOES S PSGOES=1
- I X="" S (Y,PSIVQUIY)=""
- S PSIVSPQF=1 D EN^PSIVSP K PSIVSPQF
- S P(11)=$S($P(PSIVX0,"^",6)]"":$P(PSIVX0,"^",6),(PSIVQZ]""&(PSIVWAT]"")):PSIVWAT,PSIVAAT]"":PSIVAAT,$G(P(11))]"":$G(P(11)),1:PSIVAT)
- S X=$P(PSIVX0,"^",3)
- I $P(PSIVX0,U,8) D
- .S P("MR")=+$P(PSIVX0,U,8)_U_$S($P($G(^PS(51.2,+$P(PSIVX0,U,8),0)),U,3):$P($G(^PS(51.2,+$P(PSIVX0,U,8),0)),U,3),1:$E($P($G(^PS(51.2,+$P(PSIVX0,U,8),0)),U),1,5))
- W " ",X D ENI^PSIVSP I '$D(X) W $C(7)," --> Invalid infusion rate !!" I '$$SCHREQ^PSJLIVFD(.P) S P(15)=0
- I $$SCHREQ^PSJLIVFD(.P),'$$DOW^PSIVUTL($G(P(9))),'(P(15)>0) S P(15)=$$INTERVAL^PSIVUTL(.P)
- S PSIVOK="57^58^59^3^26^39^63^64^"_$S($E(P("OT"))="I":"101^109^",1:"")_"10^25^1"
- S P(17)="A",P(8)=$S($D(X):X,1:""),PSIVE=0,PSIVSTR="QUICK CODE",(DRG(2),Y)="",EDIT=$S(+P("MR"):"",1:"3^")_$P(EDIT,"64^",2) K ND,PSIVX0,PSIVSC,PSIVX
- Q
- PSIVQUI ;BIR/RGY,MLM-HANDLE QUICK CODE ENTRIES ;15 Dec 98 / 8:29 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**21,50,65,73,76,93,104,110**;16 DEC 97
- +2 ;
- +3 ;Reference to ^PS(51.1 is supported by DBIA 2177
- +4 ;Reference to ^PS(51.2 is supported by DBIA 2178
- +5 ;Reference to ^PS(52.6 is supported by DBIA 1231
- +6 ;Reference to ^PS(52.7 is supported by DBIA 2173
- +7 ;
- +8 NEW X,PSIVSC1
- SET (PSIVAT,PSIVAAT,PSIVWAT)=""
- SET PSIVQUIY=Y
- SET (X,PSIVQUIX)=PSIVX
- +9 IF 'Y!(PSIVQUIX="")
- QUIT
- SET PSIVX0=$ORDER(^PS(52.6,"C",X,+Y,0))
- SET PSIVX0=$GET(^PS(52.6,+Y,1,PSIVX0,0))
- +10 IF $PIECE(PSIVX0,"^",5)]""!$PIECE(PSIVX0,"^",6)!(P(5))
- SET PSIVAAT=$PIECE(PSIVX0,"^",6)
- +11 KILL PSIVX0
- SET Y=PSIVQUIY
- SET Y(0)=$GET(^PS(52.6,+Y,0))
- SET X=PSIVQUIX
- +12 IF $SELECT('$DATA(X)
- QUIT
- SET KILL DRG
- SET PSIVX0=$SELECT($DATA(^PS(52.6,+Y,1,+$ORDER(^PS(52.6,"C",X,+Y,0)),0)):^(0),1:"")
- SET (DRGI,DRG("AD",0))=1
- SET TDRG("AD",+Y,DRGI)=""
- SET DRG("AD",DRGI)=+Y_U_$PIECE(Y(0),U)_U_$PIECE(PSIVX0,"^",2)_U_U_$PIECE(Y(0),U,13)_U_$PIECE(Y(0),U,11)
- +1 NEW PSIVQZ,PSIVADD0,PSIVSZ,PSIVAZ,PSIVXAT,PSIVSIEN,PSIVXW
- SET PSIVSIEN=0
- +2 IF $PIECE(PSIVX0,U,4)]""
- SET P("OPI")=$PIECE(PSIVX0,U,4)
- +3 IF $PIECE(PSIVX0,U,7)?1N.N
- Begin DoDot:1
- +4 SET ND=$GET(^PS(52.7,$PIECE(PSIVX0,U,7),0))
- +5 WRITE !!,"SOLUTION: ",$PIECE(ND,U),!
- +6 NEW FIL
- SET FIL="52.7"
- SET DRGTMP=$PIECE(PSIVX0,U,7)
- DO ORDERCHK^PSIVEDRG(DFN,ON55,1)
- +7 IF $GET(PSGORQF)
- SET X="^"
- SET DONE=1
- QUIT
- +8 SET DRG("SOL",0)=1
- SET DRG("SOL",1)=$PIECE(PSIVX0,U,7)_U_$PIECE(ND,U)_U_$PIECE(ND,U,3)_U_U_$PIECE(ND,U,13)_U_$PIECE(ND,U,11)
- SET TDRG("SOL",$PIECE(PSIVX0,U,7),1)=""
- End DoDot:1
- IF $GET(PSGORQF)
- QUIT
- +9 IF $PIECE(PSIVX0,U,5)]""!P(5)
- SET X=$PIECE(PSIVX0,U,5)
- +10 SET PSIVQZ=$PIECE(PSIVX0,U,5)
- SET PSIVQAZ=$PIECE(PSIVX0,U,6)
- SET PSIVADD0=$GET(^PS(52.6,+PSIVQUIY,0))
- SET X=PSIVQZ
- +11 SET PSIVSZ=$PIECE(PSIVADD0,"^",5)
- SET PSIVAZ=$PIECE(PSIVADD0,"^",6)
- +12 SET PSIVAAT=$SELECT(PSIVQZ]""&(PSIVQAZ]""):PSIVQAZ,PSIVQZ=""&(PSIVSZ]""):PSIVAZ,PSIVQZ=PSIVSZ:PSIVAZ,1:"")
- +13 IF $PIECE(PSIVX0,U,5)']""!P(5)
- SET X=$SELECT(X]"":X,1:$PIECE($GET(^PS(52.6,+PSIVQUIY,0)),"^",5))
- +14 ;
- +15 ; If a sched was found, check all matching schedules
- +16 ; in 51.1 against $P(PSIVX0,"^",5), PSIVAAT, PSIVWAT
- +17 IF PSIVQZ]""
- IF $GET(X)'=""
- SET ZZ=0
- Begin DoDot:1
- +18 ;if ZZ sched/times matches quick code sched/times, use the schedule
- +19 FOR
- SET ZZ=$ORDER(^PS(51.1,"AC","PSJ",X,ZZ))
- IF 'ZZ!PSIVSIEN
- QUIT
- Begin DoDot:2
- +20 NEW PSIVXAT
- SET PSIVXAT=$PIECE(^PS(51.1,ZZ,0),"^",2)
- IF PSIVXAT=""
- QUIT
- +21 IF PSIVXAT=$PIECE(PSIVX0,"^",6)
- SET PSIVAT=$PIECE(PSIVX0,"^",6)
- SET PSIVSIEN=ZZ
- End DoDot:2
- IF PSIVSIEN
- QUIT
- End DoDot:1
- +22 ;
- +23 ; If quick code has no schedule, check IV additive
- +24 IF PSIVAT=""
- IF $PIECE(PSIVX0,"^",5)=""
- IF $GET(X)'=""
- SET ZZ=0
- Begin DoDot:1
- +25 FOR
- SET ZZ=$ORDER(^PS(51.1,"AC","PSJ",X,ZZ))
- IF 'ZZ!PSIVSIEN
- QUIT
- Begin DoDot:2
- +26 NEW PSIVXAT
- SET PSIVXAT=$PIECE(^PS(51.1,ZZ,0),"^",2)
- IF PSIVXAT=""
- QUIT
- +27 IF PSIVAAT=PSIVXAT
- IF (X=PSIVSZ)
- SET PSIVAT=PSIVAAT
- SET PSIVSIEN=ZZ
- End DoDot:2
- IF PSIVSIEN
- QUIT
- +28 IF PSIVAT=""
- IF PSIVAAT]""
- SET PSIVAT=PSIVAAT
- SET $PIECE(PSIVX0,"^",6)=PSIVAAT
- SET $PIECE(PSIVX0,"^",5)=PSIVSZ
- SET PSIVSIEN=-1
- End DoDot:1
- +29 ;
- +30 ; If quick code has schedule, no admin times, use ward times
- +31 IF PSIVAT=""
- IF PSIVQZ]""
- IF $GET(X)'=""
- Begin DoDot:1
- +32 SET PSIVXW=$SELECT($GET(WSCHADM):WSCHADM,$GET(VAIN(4)):+VAIN(4),1:"")
- IF 'PSIVXW
- QUIT
- +33 SET ZZ=0
- FOR
- SET ZZ=$ORDER(^PS(51.1,"AC","PSJ",X,ZZ))
- IF 'ZZ!PSIVSIEN
- QUIT
- Begin DoDot:2
- +34 NEW PSIVXAT
- SET PSIVXAT=$PIECE(^PS(51.1,ZZ,0),"^",2)
- IF PSIVXAT=""
- QUIT
- +35 SET PSIVWAT=$PIECE($GET(^PS(51.1,ZZ,1,+PSIVXW,0)),"^",2)
- +36 IF PSIVWAT]""
- SET PSIVAT=PSIVWAT
- SET PSIVSIEN=ZZ
- End DoDot:2
- IF PSIVSIEN
- QUIT
- End DoDot:1
- +37 ;
- +38 ; No ward times; go back to IV additive. If quick code has schedule,
- +39 ; make sure it matches IV additive
- +40 IF PSIVAT=""
- IF PSIVAAT]""
- IF PSIVWAT=""
- IF $GET(X)
- Begin DoDot:1
- +41 SET ZZ=0
- FOR
- SET ZZ=$ORDER(^PS(51.1,"AC","PSJ",X,ZZ))
- IF 'ZZ!PSIVSIEN
- QUIT
- Begin DoDot:2
- +42 NEW PSIVXAT
- SET PSIVXAT=$PIECE(^PS(51.1,ZZ,0),"^",2)
- IF PSIVXAT=""
- QUIT
- +43 IF (PSIVQZ=X&(PSIVQZ=PSIVSZ))!(PSIVQZ=""&(PSIVSZ]""))
- IF PSIVXAT=PSIVAAT
- Begin DoDot:3
- +44 SET PSIVAT=PSIVAAT
- SET PSIVSIEN=ZZ
- End DoDot:3
- QUIT
- End DoDot:2
- IF PSIVSIEN
- QUIT
- +45 IF PSIVAT=""
- SET PSIVAT=PSIVAAT
- SET $PIECE(PSIVX0,"^",6)=PSIVAAT
- SET $PIECE(PSIVX0,"^",5)=X
- SET PSIVSIEN=-1
- End DoDot:1
- +46 IF $GET(PSIVSIEN)
- SET Y=$SELECT(PSIVSIEN>0:PSIVSIEN,1:"")
- NEW PSGOES
- SET PSGOES=1
- +47 IF X=""
- SET (Y,PSIVQUIY)=""
- +48 SET PSIVSPQF=1
- DO EN^PSIVSP
- KILL PSIVSPQF
- +49 SET P(11)=$SELECT($PIECE(PSIVX0,"^",6)]"":$PIECE(PSIVX0,"^",6),(PSIVQZ]""&(PSIVWAT]"")):PSIVWAT,PSIVAAT]"":PSIVAAT,$GET(P(11))]"":$GET(P(11)),1:PSIVAT)
- +50 SET X=$PIECE(PSIVX0,"^",3)
- +51 IF $PIECE(PSIVX0,U,8)
- Begin DoDot:1
- +52 SET P("MR")=+$PIECE(PSIVX0,U,8)_U_$SELECT($PIECE($GET(^PS(51.2,+$PIECE(PSIVX0,U,8),0)),U,3):$PIECE($GET(^PS(51.2,+$PIECE(PSIVX0,U,8),0)),U,3),1:$EXTRACT($PIECE($GET(^PS(51.2,+$PIECE(PSIVX0,U,8),0)),U),1,5))
- End DoDot:1
- +53 WRITE " ",X
- DO ENI^PSIVSP
- IF '$DATA(X)
- WRITE $CHAR(7)," --> Invalid infusion rate !!"
- IF '$$SCHREQ^PSJLIVFD(.P)
- SET P(15)=0
- +54 IF $$SCHREQ^PSJLIVFD(.P)
- IF '$$DOW^PSIVUTL($GET(P(9)))
- IF '(P(15)>0)
- SET P(15)=$$INTERVAL^PSIVUTL(.P)
- +55 SET PSIVOK="57^58^59^3^26^39^63^64^"_$SELECT($EXTRACT(P("OT"))="I":"101^109^",1:"")_"10^25^1"
- +56 SET P(17)="A"
- SET P(8)=$SELECT($DATA(X):X,1:"")
- SET PSIVE=0
- SET PSIVSTR="QUICK CODE"
- SET (DRG(2),Y)=""
- SET EDIT=$SELECT(+P("MR"):"",1:"3^")_$PIECE(EDIT,"64^",2)
- KILL ND,PSIVX0,PSIVSC,PSIVX
- +57 QUIT
