- PSJORPOE ;BIR/MLM,LDT-MISC. PROCEDURE CALLS FOR OE/RR 3.0 ;24 Feb 99 / 10:43 AM
- ;;5.0; INPATIENT MEDICATIONS ;**50,56,92,80,110,127,133,134**;16 DEC 97;Build 124
- ;
- ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- ; Reference to ^PS(51.2 is supported by DBIA# 2178.
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Reference to ^PS(51.1 is supported by DBIA# 2177.
- ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- ; Reference to ^PSDRUG is supported by DBIA# 2192.
- ;
- STARTSTP(PSGP,SCH,OI,PSJPWD,PSGORD,PSJADM) ;
- ; PSGP=Patient IEN
- ; SCH=Schedule
- ; OI=Orderable Item
- ; PSJPWD=Ward Location (Optional)
- ; PSGORD=Pharmacy Order Number if the order being placed is a Renewal (Optional)
- ;
- Q:+PSGP'>0 ""
- Q:SCH']"" ""
- Q:+OI'>0 ""
- I SCH?.E1L.E S SCH=$$ENLU^PSGMI(SCH)
- K DFN,PSGNEFDO,PSGNEFD,PSGST,PSGSCH,PSGNEDFD,PSGNESD,PSJSYSW,PSJSYSW0 N RESULT
- S:'$D(PSGS0XT) PSGS0XT="" S:'$D(PSGS0Y) PSGSOY=""
- I $G(PSJPWD)']"" S DFN=PSGP D IN5^VADPT S:VAIP(5)]"" PSJPWD=+VAIP(5)
- S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD)]"" S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
- S RESULT=$S($P(PSJSYSW0,"^",5)=0:"CLOSEST",$P(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
- I OI]"" S PSGST=$S($P($G(^PS(50.7,OI,0)),"^",7)]"":$P($G(^PS(50.7,OI,0)),"^",7),1:"C")
- N %,PSGXSCH D NOW^%DTC S PSGDT=%,DFN=PSGP,(PSGSCH,PSGXSCH)=SCH
- S X=PSGSCH,PSGS0Y="" D ADMIN
- I $G(PSGORD)]"" D
- .S PSGNESD=$$DSTART^PSJDCU(PSGP,PSGORD) I PSGNESD]"" S $P(RESULT,"^",2)=PSGNESD Q
- .S ND=$S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,2)),1:$G(^PS(55,PSGP,"IV",+PSGORD,0)))
- .N PSJADM,PSJSTRT S PSJADM=$S(PSGORD["U":$P(ND,"^",5),1:$P(ND,"^",11)),PSJSTRT=$P(ND,"^",2),PSJREN=1
- S SCH=PSGXSCH
- N PSJTMPW0 S PSJTMPW0=PSJSYSW0 S $P(PSJSYSW0,"^",5)=1
- I $G(PSGNESD)="" S RESULT=RESULT_"^"_$$ENSD^PSGNE3(PSGSCH,$S($G(PSJADM)]"":$G(PSJADM),1:PSGS0Y),PSGDT,$S($G(PSJSTRT)]"":$G(PSJSTRT),1:PSGDT))
- S PSJSYSW0=PSJTMPW0
- S PSGNESD=$P(RESULT,"^",2)
- S PSGNEDFD=$$GTNEDFD^PSGOE7("U",OI)
- K PSGODF,PSGOES,PSJREN
- S SCH=PSGXSCH
- D ENFD^PSGNE3(PSGDT) S RESULT=RESULT_"^"_$G(PSGNEFD) ;_"^"_$G(PSGNEFDO)
- N DATE S DATE=$$FMDIFF^XLFDT($P(RESULT,"^",3),$P(RESULT,"^",2),3)
- S $P(RESULT,"^",3)=$S($G(PSGST)="O":0,+DATE>0:+DATE_"D",$P($P(DATE," ",2),":")>0:$P($P(DATE," ",2),":")_"H",1:0)
- N STRING S STRING=PSGNESD_U_PSGNEFD_U_$G(PSGSCH)_U_$G(PSGST)_U_$G(OI) I ($P($G(ZZND),U,2)]"")&($P($G(ZZND),"^")=$G(PSGSCH)) S STRING=STRING_U_$P(ZZND,U,2)
- I $G(PSGSCH)]"" I $$DOW^PSIVUTL(PSGSCH) S:$G(PSGS0Y) $P(STRING,"^",6)=PSGS0Y
- I $G(PSJADM) S $P(STRING,"^",6)=PSJADM
- S RESULT=RESULT_"^"_$$ENQ^PSJORP2(PSGP,STRING) I ($G(PSGSCH)]"") I $$DOW^PSIVUTL(PSGSCH),(PSGSCH'["@"),'$G(PSGS0Y) S $P(RESULT,"^",4)=$P(RESULT,"^",2)
- I ($G(PSGSCH)]"") I $$PRNOK^PSGS0(PSGSCH) S $P(RESULT,"^",4)=$P(RESULT,"^",2)
- D KVAR^VADPT K LYN,ND,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ
- ;RESULT=WARD PARAMETER^DEFAULT START DATE/TIME^#_D(NUMBER OF DAYS ORDER LASTS) OR #_H(NUMBER OF HOURS ORDER LASTS)^EXPECTED FIRST DOSE
- Q RESULT
- ;
- RESOLVE(PSGP,SCH,OI,PCH,PSJPWD,PSJADM) ;
- ; PSGP=Patient IEN
- ; SCH=Schedule
- ; OI=Orderable Item
- ; PCH=Providers Choice
- ; PSJPWD=Ward Location (Optional)
- ; PSJADM=Admin Times (Optional)
- ;
- N PSJSYSW0,PSJSYSW,PSGSCH,PSGOES,PSGS0Y,DFN,RESULT1
- I $G(PSJPWD)']"" S DFN=PSGP D IN5^VADPT S:VAIP(5)]"" PSJPWD=+VAIP(5)
- S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD)]"" S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
- S $P(PSJSYSW0,"^",5)=$S($$ONE(SCH):2,PCH="NEXT":1,1:0)
- S RESULT1=$S($P(PSJSYSW0,"^",5)=0:"CLOSEST",$P(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
- I OI]"" S PSGST=$S($P($G(^PS(50.7,OI,0)),"^",7)]"":$P($G(^PS(50.7,OI,0)),"^",7),1:"C")
- N % D NOW^%DTC S PSGDT=%,DFN=PSGP,PSGSCH=SCH
- S X=PSGSCH,PSGS0Y="" I $D(^PS(51.1,"AC","PSJ",X)) D ADMIN
- S:$G(PSJADM) PSGS0Y=PSJADM
- S RESULT1=RESULT1_"^"_$$ENSD^PSGNE3(SCH,PSGS0Y,PSGDT,PSGDT)
- I $G(PSGSCH)]"" I $$DOW^PSIVUTL(PSGSCH),(PSGSCH'["@"),'$G(PSGS0Y) S $P(RESULT,"^",4)=$P(RESULT,"^",2)
- I $G(PSGSCH)]"" I $$PRNOK^PSGS0(PSGSCH) S $P(RESULT1,"^",4)=$P(RESULT,"^",2)
- D KVAR^VADPT K LYN,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ,PSGS0XT,PSGS0Y
- Q RESULT1
- ;
- SCHREQ(MR,OI,DD) ;
- ; MR=Medication Route from 51.2 (Required)
- ; OI=Orderable Item from 50.7 (Optional)
- ; DD=Dispense Drug from 50 (Optional)
- N ADDITIVE,SOLUTION,REQ S REQ=0,(SOLUTION,ADDITIVE)=""
- I '+$G(MR) S REQ=1 Q REQ
- I '+$G(OI),'+$G(DD) S REQ=1 Q REQ
- I +$G(DD) S:$P($G(^PSDRUG(+DD,2)),U,3)["U" REQ=1 Q REQ
- I '$D(PS(51.2,+MR,0)) S REQ=1 Q REQ
- I $P($G(^PS(51.2,+MR,0)),"^",6)=1 D
- .I +$G(OI) D
- ..I '$D(^PS(50.7,+OI,0)) S REQ=1 Q
- ..F S SOLUTION=$O(^PS(52.7,"AOI",+OI,SOLUTION)) Q:'SOLUTION Q:REQ=1 S:$P(^PSDRUG(+$P(^PS(52.7,SOLUTION,0),U,2),2),U,3)["U" REQ=1
- ..F S ADDITIVE=$O(^PS(52.6,"AOI",+OI,ADDITIVE)) Q:'ADDITIVE Q:REQ=1 S:$P(^PSDRUG(+$P(^PS(52.6,ADDITIVE,0),U,2),2),U,3)["U" REQ=1
- Q REQ
- ;
- ADMIN ; Get admin times associated with schedule
- S PSGS0Y="",ZZ=0
- I $$DOW^PSIVUTL($P(X,"@")),'$D(^PS(51.1,"AC","PSJ",X)) S PSGST="D" D Q:$G(PSGS0Y)
- .I $P(X,"@",2) N PSJADBAD D Q
- ..S PSGS0Y=$S($G(PSJADBAD):"",1:$P(X,"@",2))
- ..N ADMIN,TIME,II S ADMIN=$P(X,"@",2) F II=1:1:$L(ADMIN,"-") S TIME=$P(ADMIN,"-",II) I TIME'?2N&(TIME'?4N) S PSJADBAD=1
- .I $P(X,"@",2)]"",$D(^PS(51.1,"APPSJ",$P(X,"@",2))) S X=$P(X,"@",2)
- D FIND^DIC(51.1,,,,X,,"APPSJ",,,"LYN")
- S ZZ=$O(LYN("DILIST",2,ZZ)) I ZZ S ZZ=+LYN("DILIST",2,ZZ) I ZZ S ZZND=$G(^PS(51.1,ZZ,0)) S PSGST=$P(ZZND,U,5),PSGS0XT=$P(ZZND,U,3) S:$G(PSGSFLG) PSGSCIEN=$G(LYN("DILIST",2,ZZ)) I $G(PSJPWD) D
- . N ZZNDW S ZZNDW=$G(^PS(51.1,ZZ,1,PSJPWD,0)) I $P(ZZNDW,"^",2)]"" S PSGS0Y=$P(ZZNDW,"^",2),$P(ZZND,"^",2)=PSGS0Y I $G(PSGSFLG) S PSGSCIEN=$G(LYN("DILIST",2,ZZ))
- S ZZ=0 F S ZZ=$O(LYN("DILIST",1,ZZ)) Q:'ZZ I $G(LYN("DILIST",1,ZZ))'=X K LYN("DILIST",1,ZZ),LYN("DILIST",2,ZZ),LYN("DILIST","ID",ZZ,1)
- I $D(PSJPWD) S ZZ=0 F S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ!$G(PSGS0Y) I $P($G(^PS(51.1,+LYN("DILIST",2,ZZ),1,+PSJPWD,0)),U,2)]"" S PSGS0Y=$P($G(^(0)),U,2) I $G(PSGSFLG) S PSGSCIEN=$G(LYN("DILIST",2,ZZ))
- Q:PSGS0Y]"" S ZZ=0 F S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ!$G(PSGS0Y) I $G(LYN("DILIST","ID",ZZ,1))]"" S PSGS0Y=$G(LYN("DILIST","ID",ZZ,1))
- Q
- ;
- ONE(SCH) ;
- ; SCH=Admin Schedule
- ; Returns 0 = (zero) Not a one time schedule.
- ; 1 = One time schedule.
- Q:$G(SCH)="" 0
- N X,SCHLST
- S SCHLST=",TODAY,ONCE,NOW,ONE TIME,ONETIME,ONE-TIME,1TIME,1 TIME,1-TIME,STAT,"
- I SCHLST[(","_SCH_",") Q 1
- I $D(^PS(51.1,"AC","PSJ",SCH)) S X=$O(^(SCH,"")) S X=$P(^PS(51.1,X,0),"^",5) Q $S(X="O":1,1:0)
- Q 0
- PSJORPOE ;BIR/MLM,LDT-MISC. PROCEDURE CALLS FOR OE/RR 3.0 ;24 Feb 99 / 10:43 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**50,56,92,80,110,127,133,134**;16 DEC 97;Build 124
- +2 ;
- +3 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- +4 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
- +5 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +6 ; Reference to ^PS(51.1 is supported by DBIA# 2177.
- +7 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- +8 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- +9 ; Reference to ^PSDRUG is supported by DBIA# 2192.
- +10 ;
- STARTSTP(PSGP,SCH,OI,PSJPWD,PSGORD,PSJADM) ;
- +1 ; PSGP=Patient IEN
- +2 ; SCH=Schedule
- +3 ; OI=Orderable Item
- +4 ; PSJPWD=Ward Location (Optional)
- +5 ; PSGORD=Pharmacy Order Number if the order being placed is a Renewal (Optional)
- +6 ;
- +7 IF +PSGP'>0
- QUIT ""
- +8 IF SCH']""
- QUIT ""
- +9 IF +OI'>0
- QUIT ""
- +10 IF SCH?.E1L.E
- SET SCH=$$ENLU^PSGMI(SCH)
- +11 KILL DFN,PSGNEFDO,PSGNEFD,PSGST,PSGSCH,PSGNEDFD,PSGNESD,PSJSYSW,PSJSYSW0
- NEW RESULT
- +12 IF '$DATA(PSGS0XT)
- SET PSGS0XT=""
- IF '$DATA(PSGS0Y)
- SET PSGSOY=""
- +13 IF $GET(PSJPWD)']""
- SET DFN=PSGP
- DO IN5^VADPT
- IF VAIP(5)]""
- SET PSJPWD=+VAIP(5)
- +14 SET PSJSYSW0=""
- SET PSJSYSW=0
- IF $GET(PSJPWD)]""
- SET PSJSYSW=+$ORDER(^PS(59.6,"B",PSJPWD,0))
- IF PSJSYSW
- SET PSJSYSW0=$GET(^PS(59.6,PSJSYSW,0))
- +15 SET RESULT=$SELECT($PIECE(PSJSYSW0,"^",5)=0:"CLOSEST",$PIECE(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
- +16 IF OI]""
- SET PSGST=$SELECT($PIECE($GET(^PS(50.7,OI,0)),"^",7)]"":$PIECE($GET(^PS(50.7,OI,0)),"^",7),1:"C")
- +17 NEW %,PSGXSCH
- DO NOW^%DTC
- SET PSGDT=%
- SET DFN=PSGP
- SET (PSGSCH,PSGXSCH)=SCH
- +18 SET X=PSGSCH
- SET PSGS0Y=""
- DO ADMIN
- +19 IF $GET(PSGORD)]""
- Begin DoDot:1
- +20 SET PSGNESD=$$DSTART^PSJDCU(PSGP,PSGORD)
- IF PSGNESD]""
- SET $PIECE(RESULT,"^",2)=PSGNESD
- QUIT
- +21 SET ND=$SELECT(PSGORD["U":$GET(^PS(55,PSGP,5,+PSGORD,2)),1:$GET(^PS(55,PSGP,"IV",+PSGORD,0)))
- +22 NEW PSJADM,PSJSTRT
- SET PSJADM=$SELECT(PSGORD["U":$PIECE(ND,"^",5),1:$PIECE(ND,"^",11))
- SET PSJSTRT=$PIECE(ND,"^",2)
- SET PSJREN=1
- End DoDot:1
- +23 SET SCH=PSGXSCH
- +24 NEW PSJTMPW0
- SET PSJTMPW0=PSJSYSW0
- SET $PIECE(PSJSYSW0,"^",5)=1
- +25 IF $GET(PSGNESD)=""
- SET RESULT=RESULT_"^"_$$ENSD^PSGNE3(PSGSCH,$SELECT($GET(PSJADM)]"":$GET(PSJADM),1:PSGS0Y),PSGDT,$SELECT($GET(PSJSTRT)]"":$GET(PSJSTRT),1:PSGDT))
- +26 SET PSJSYSW0=PSJTMPW0
- +27 SET PSGNESD=$PIECE(RESULT,"^",2)
- +28 SET PSGNEDFD=$$GTNEDFD^PSGOE7("U",OI)
- +29 KILL PSGODF,PSGOES,PSJREN
- +30 SET SCH=PSGXSCH
- +31 ;_"^"_$G(PSGNEFDO)
- DO ENFD^PSGNE3(PSGDT)
- SET RESULT=RESULT_"^"_$GET(PSGNEFD)
- +32 NEW DATE
- SET DATE=$$FMDIFF^XLFDT($PIECE(RESULT,"^",3),$PIECE(RESULT,"^",2),3)
- +33 SET $PIECE(RESULT,"^",3)=$SELECT($GET(PSGST)="O":0,+DATE>0:+DATE_"D",$PIECE($PIECE(DATE," ",2),":")>0:$PIECE($PIECE(DATE," ",2),":")_"H",1:0)
- +34 NEW STRING
- SET STRING=PSGNESD_U_PSGNEFD_U_$GET(PSGSCH)_U_$GET(PSGST)_U_$GET(OI)
- IF ($PIECE($GET(ZZND),U,2)]"")&($PIECE($GET(ZZND),"^")=$GET(PSGSCH))
- SET STRING=STRING_U_$PIECE(ZZND,U,2)
- +35 IF $GET(PSGSCH)]""
- IF $$DOW^PSIVUTL(PSGSCH)
- IF $GET(PSGS0Y)
- SET $PIECE(STRING,"^",6)=PSGS0Y
- +36 IF $GET(PSJADM)
- SET $PIECE(STRING,"^",6)=PSJADM
- +37 SET RESULT=RESULT_"^"_$$ENQ^PSJORP2(PSGP,STRING)
- IF ($GET(PSGSCH)]"")
- IF $$DOW^PSIVUTL(PSGSCH)
- IF (PSGSCH'["@")
- IF '$GET(PSGS0Y)
- SET $PIECE(RESULT,"^",4)=$PIECE(RESULT,"^",2)
- +38 IF ($GET(PSGSCH)]"")
- IF $$PRNOK^PSGS0(PSGSCH)
- SET $PIECE(RESULT,"^",4)=$PIECE(RESULT,"^",2)
- +39 DO KVAR^VADPT
- KILL LYN,ND,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ
- +40 ;RESULT=WARD PARAMETER^DEFAULT START DATE/TIME^#_D(NUMBER OF DAYS ORDER LASTS) OR #_H(NUMBER OF HOURS ORDER LASTS)^EXPECTED FIRST DOSE
- +41 QUIT RESULT
- +42 ;
- RESOLVE(PSGP,SCH,OI,PCH,PSJPWD,PSJADM) ;
- +1 ; PSGP=Patient IEN
- +2 ; SCH=Schedule
- +3 ; OI=Orderable Item
- +4 ; PCH=Providers Choice
- +5 ; PSJPWD=Ward Location (Optional)
- +6 ; PSJADM=Admin Times (Optional)
- +7 ;
- +8 NEW PSJSYSW0,PSJSYSW,PSGSCH,PSGOES,PSGS0Y,DFN,RESULT1
- +9 IF $GET(PSJPWD)']""
- SET DFN=PSGP
- DO IN5^VADPT
- IF VAIP(5)]""
- SET PSJPWD=+VAIP(5)
- +10 SET PSJSYSW0=""
- SET PSJSYSW=0
- IF $GET(PSJPWD)]""
- SET PSJSYSW=+$ORDER(^PS(59.6,"B",PSJPWD,0))
- IF PSJSYSW
- SET PSJSYSW0=$GET(^PS(59.6,PSJSYSW,0))
- +11 SET $PIECE(PSJSYSW0,"^",5)=$SELECT($$ONE(SCH):2,PCH="NEXT":1,1:0)
- +12 SET RESULT1=$SELECT($PIECE(PSJSYSW0,"^",5)=0:"CLOSEST",$PIECE(PSJSYSW0,"^",5)=1:"NEXT",1:"NOW")
- +13 IF OI]""
- SET PSGST=$SELECT($PIECE($GET(^PS(50.7,OI,0)),"^",7)]"":$PIECE($GET(^PS(50.7,OI,0)),"^",7),1:"C")
- +14 NEW %
- DO NOW^%DTC
- SET PSGDT=%
- SET DFN=PSGP
- SET PSGSCH=SCH
- +15 SET X=PSGSCH
- SET PSGS0Y=""
- IF $DATA(^PS(51.1,"AC","PSJ",X))
- DO ADMIN
- +16 IF $GET(PSJADM)
- SET PSGS0Y=PSJADM
- +17 SET RESULT1=RESULT1_"^"_$$ENSD^PSGNE3(SCH,PSGS0Y,PSGDT,PSGDT)
- +18 IF $GET(PSGSCH)]""
- IF $$DOW^PSIVUTL(PSGSCH)
- IF (PSGSCH'["@")
- IF '$GET(PSGS0Y)
- SET $PIECE(RESULT,"^",4)=$PIECE(RESULT,"^",2)
- +19 IF $GET(PSGSCH)]""
- IF $$PRNOK^PSGS0(PSGSCH)
- SET $PIECE(RESULT1,"^",4)=$PIECE(RESULT,"^",2)
- +20 DO KVAR^VADPT
- KILL LYN,PSGDT,PSGNEDFD,PSGNEFD,PSGNEFDO,PSGNESD,PSGS0Y,PSGSCH,PSGST,PSJSYSW,PSJSYSW0,ZZ,PSGS0XT,PSGS0Y
- +21 QUIT RESULT1
- +22 ;
- SCHREQ(MR,OI,DD) ;
- +1 ; MR=Medication Route from 51.2 (Required)
- +2 ; OI=Orderable Item from 50.7 (Optional)
- +3 ; DD=Dispense Drug from 50 (Optional)
- +4 NEW ADDITIVE,SOLUTION,REQ
- SET REQ=0
- SET (SOLUTION,ADDITIVE)=""
- +5 IF '+$GET(MR)
- SET REQ=1
- QUIT REQ
- +6 IF '+$GET(OI)
- IF '+$GET(DD)
- SET REQ=1
- QUIT REQ
- +7 IF +$GET(DD)
- IF $PIECE($GET(^PSDRUG(+DD,2)),U,3)["U"
- SET REQ=1
- QUIT REQ
- +8 IF '$DATA(PS(51.2,+MR,0))
- SET REQ=1
- QUIT REQ
- +9 IF $PIECE($GET(^PS(51.2,+MR,0)),"^",6)=1
- Begin DoDot:1
- +10 IF +$GET(OI)
- Begin DoDot:2
- +11 IF '$DATA(^PS(50.7,+OI,0))
- SET REQ=1
- QUIT
- +12 FOR
- SET SOLUTION=$ORDER(^PS(52.7,"AOI",+OI,SOLUTION))
- IF 'SOLUTION
- QUIT
- IF REQ=1
- QUIT
- IF $PIECE(^PSDRUG(+$PIECE(^PS(52.7,SOLUTION,0),U,2),2),U,3)["U"
- SET REQ=1
- +13 FOR
- SET ADDITIVE=$ORDER(^PS(52.6,"AOI",+OI,ADDITIVE))
- IF 'ADDITIVE
- QUIT
- IF REQ=1
- QUIT
- IF $PIECE(^PSDRUG(+$PIECE(^PS(52.6,ADDITIVE,0),U,2),2),U,3)["U"
- SET REQ=1
- End DoDot:2
- End DoDot:1
- +14 QUIT REQ
- +15 ;
- ADMIN ; Get admin times associated with schedule
- +1 SET PSGS0Y=""
- SET ZZ=0
- +2 IF $$DOW^PSIVUTL($PIECE(X,"@"))
- IF '$DATA(^PS(51.1,"AC","PSJ",X))
- SET PSGST="D"
- Begin DoDot:1
- +3 IF $PIECE(X,"@",2)
- NEW PSJADBAD
- Begin DoDot:2
- +4 SET PSGS0Y=$SELECT($GET(PSJADBAD):"",1:$PIECE(X,"@",2))
- +5 NEW ADMIN,TIME,II
- SET ADMIN=$PIECE(X,"@",2)
- FOR II=1:1:$LENGTH(ADMIN,"-")
- SET TIME=$PIECE(ADMIN,"-",II)
- IF TIME'?2N&(TIME'?4N)
- SET PSJADBAD=1
- End DoDot:2
- QUIT
- +6 IF $PIECE(X,"@",2)]""
- IF $DATA(^PS(51.1,"APPSJ",$PIECE(X,"@",2)))
- SET X=$PIECE(X,"@",2)
- End DoDot:1
- IF $GET(PSGS0Y)
- QUIT
- +7 DO FIND^DIC(51.1,,,,X,,"APPSJ",,,"LYN")
- +8 SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
- IF ZZ
- SET ZZ=+LYN("DILIST",2,ZZ)
- IF ZZ
- SET ZZND=$GET(^PS(51.1,ZZ,0))
- SET PSGST=$PIECE(ZZND,U,5)
- SET PSGS0XT=$PIECE(ZZND,U,3)
- IF $GET(PSGSFLG)
- SET PSGSCIEN=$GET(LYN("DILIST",2,ZZ))
- IF $GET(PSJPWD)
- Begin DoDot:1
- +9 NEW ZZNDW
- SET ZZNDW=$GET(^PS(51.1,ZZ,1,PSJPWD,0))
- IF $PIECE(ZZNDW,"^",2)]""
- SET PSGS0Y=$PIECE(ZZNDW,"^",2)
- SET $PIECE(ZZND,"^",2)=PSGS0Y
- IF $GET(PSGSFLG)
- SET PSGSCIEN=$GET(LYN("DILIST",2,ZZ))
- End DoDot:1
- +10 SET ZZ=0
- FOR
- SET ZZ=$ORDER(LYN("DILIST",1,ZZ))
- IF 'ZZ
- QUIT
- IF $GET(LYN("DILIST",1,ZZ))'=X
- KILL LYN("DILIST",1,ZZ),LYN("DILIST",2,ZZ),LYN("DILIST","ID",ZZ,1)
- +11 IF $DATA(PSJPWD)
- SET ZZ=0
- FOR
- SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
- IF 'ZZ!$GET(PSGS0Y)
- QUIT
- IF $PIECE($GET(^PS(51.1,+LYN("DILIST",2,ZZ),1,+PSJPWD,0)),U,2)]""
- SET PSGS0Y=$PIECE($GET(^(0)),U,2)
- IF $GET(PSGSFLG)
- SET PSGSCIEN=$GET(LYN("DILIST",2,ZZ))
- +12 IF PSGS0Y]""
- QUIT
- SET ZZ=0
- FOR
- SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
- IF 'ZZ!$GET(PSGS0Y)
- QUIT
- IF $GET(LYN("DILIST","ID",ZZ,1))]""
- SET PSGS0Y=$GET(LYN("DILIST","ID",ZZ,1))
- +13 QUIT
- +14 ;
- ONE(SCH) ;
- +1 ; SCH=Admin Schedule
- +2 ; Returns 0 = (zero) Not a one time schedule.
- +3 ; 1 = One time schedule.
- +4 IF $GET(SCH)=""
- QUIT 0
- +5 NEW X,SCHLST
- +6 SET SCHLST=",TODAY,ONCE,NOW,ONE TIME,ONETIME,ONE-TIME,1TIME,1 TIME,1-TIME,STAT,"
- +7 IF SCHLST[(","_SCH_",")
- QUIT 1
- +8 IF $DATA(^PS(51.1,"AC","PSJ",SCH))
- SET X=$ORDER(^(SCH,""))
- SET X=$PIECE(^PS(51.1,X,0),"^",5)
- QUIT $SELECT(X="O":1,1:0)
- +9 QUIT 0
