PSJNEWOA ;BIR/SAB - STORES BACKDOOR ORDER CHECKS IN FILE #100.05 ;11/08/2012
;;5.0;INPATIENT MEDICATIONS;**281**;16 DEC 97;Build 113
;External reference to ^TMP("PSODAOC",$J is supported by DBIA# 6071
;External reference to GETOC4^OROCAPI1 supported by DBIA 5729
;External reference to ^ORD(100.05 supported by DBIA 5731
;External reference to ^PS(55 supported by DBIA 2191
;
;Inpatient: When verifying order within the same session, pull allergies from non-verified order to verified order
;called from VF1^PSJLIACT and PSJHL3
VF ;unit dose or pending
Q:'$G(^TMP("PSODAOC",$J,"IP IEN"))
N PSJORET,PSJZORN,RXORDER,PSJDGVER,PSJOORD,ON55
S (PSJZORN,PSJORET,PSJOORD,PSJORET)="",PSJDGVER=1,PSJOORD=$G(^TMP("PSODAOC",$J,"IP IEN"))
I $G(PSJSPEED) S PSJOORD=$G(ON55)
S (ON55,RXORDER)=$G(^TMP("PSODAOC",$J,"IP NEW IEN"))
D VF2
Q
VF1 ;IV or edit
N PSJDGORD,PSJORET,PSJZORN,RXORDER,ON55
I $G(PSIVCOPY),($G(ON55)["V") K ^TMP("PSODAOC",$J,"ALLERGY")
S (PSJZORN,PSJORET)="",(ON55,RXORDER)=$G(^TMP("PSODAOC",$J,"IP NEW IEN"))
S PSJDGORD=$G(^TMP("PSODAOC",$J,"IP IEN"))
VF2 ;
I $G(PSJDGVER)&($G(PSJOORD)) D
.I PSJOORD["P"!(PSJOORD["N") S PSJZORN=+$P(^PS(53.1,+PSJOORD,0),U,21) Q
;
I '$G(PSJREN)&('$G(PSJDGVER))&($G(PSJDGORD)) D
.I PSJDGORD["P"!(PSJDGORD["N") S PSJZORN=+$P($G(^PS(53.1,+PSJDGORD,0)),U,21) Q
.S PSJZORN=$S(PSJDGORD["V":$P($G(^PS(55,DFN,"IV",+PSJDGORD,0)),"^",21),PSJDGORD["U":$P($G(^PS(55,DFN,5,+PSJDGORD,0)),"^",21),1:"")
I $G(PSJREN)&('$G(PSJDGVER))&($G(PSJDGORD)) S PSJZORN=$S(PSJDGORD["V":$P($G(^PS(55,DFN,"IV",+PSJDGORD,0)),"^",21),PSJDGORD["U":$P($G(^PS(55,DFN,5,+PSJDGORD,0)),"^",21),1:"")
Q:'PSJZORN
D GETOC4^OROCAPI1(PSJZORN,.PSJORET)
I $O(PSJORET(PSJZORN,"DATA",""))="" K ^TMP("PSODAOC",$J) Q
;
VF3 ;
N PSJZI,PSJZIIEN,PSJNRET,PSJACNT,PSJACNT1,PSJACNT2,PSJIEN60,PSJIEN70,PSJRETI,PSJDFLAG,PSJZERO,PSOZH,PSJOZI
S (PSJACNT,PSJACNT1)=0
F PSJZI=0:0 S PSJZI=$O(PSJORET(PSJZORN,"DATA",PSJZI)) Q:'PSJZI I $D(PSJORET(PSJZORN,"DATA",PSJZI,1)) D
.Q:+$P(PSJORET(PSJZORN,"DATA",PSJZI,1),";",2)'=3
.K PSJAIENS
.I $G(PSJOZI)'=PSJZI S PSJZIIEN=0
.S PSJOZI=PSJZI,PSJACNT=PSJACNT+1
.F S PSJZIIEN=$O(^ORD(100.05,PSJZI,4,PSJZIIEN)) Q:PSJZIIEN="" I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,0)) D
..Q:$P(^ORD(100.05,PSJZI,0),"^",3)["CPRS"
..D GETS^DIQ(100.05,PSJZI,"60*","I","PSJIEN60"),GETS^DIQ(100.05,PSJZI,"70*","I","PSJIEN70")
..S PSJDFLAG="",PSJDFLAG=$$GETORD(PSJZI,$S($G(PSJDGVER):$G(PSJOORD),1:PSJDGORD),PSJDFLAG)
..Q:'$G(PSJDFLAG)
..;
..S PSJACNT1=PSJACNT1+1
..S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"ALLERGY PKG")="IP^"_$S($G(PSJOCFG)]"":$P(PSJOCFG," ")_" ",1:"")_"^"_ON55_"^"_PSJZORN
..;S:$D(^ORD(100.05,PSJZI,8)) ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"INTERVENTION")=^ORD(100.05,PSJZI,8)
..S ^TMP("PSODAOC",$J,"ALLERGY","PROVR")=$G(PSJORET(PSJZI,"DATA",PSJZIIEN,"OR",1,0))
..;
..D SETTMP
;
VF4 ;
S PSOZH="Allergy",RXORDER=ON55,PSJAOC1=1
S (ON55,RXORDER)=$G(^TMP("PSODAOC",$J,"IP NEW IEN"))
I $D(^TMP("PSODAOC",$J,"ALLERGY")) D VF2^PSJNEWOC
K ^TMP("PSODAOC",$J,"ALLERGY")
Q
;
SETTMP ;
N PSJSUBS,PSJACNT2
S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,4,PSJZIIEN,0)=$G(^ORD(100.05,PSJZI,4,PSJZIIEN,0))
;
I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,1,0)) S PSJSUBS=1 D SET1
I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,2,0)) S PSJSUBS=2 D SET1
I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,3,0)) S PSJSUBS=3 D SET1
I $D(^ORD(100.05,PSJZI,5,0)) S PSJSUBS=5 D SET2
I $D(^ORD(100.05,PSJZI,11,0)) S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"PHARM")=^ORD(100.05,PSJZI,11,0)
;WILL NEED TO SET PHARM INFO 100.05
Q
;
SET1 ;
F PSJACNT2=0:0 S PSJACNT2=$O(^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2)) Q:PSJACNT2'?1N.N D
.I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)) D
..S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)=^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)
Q
;
SET2 ;
F PSJACNT2=0:0 S PSJACNT2=$O(^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2)) Q:PSJACNT2'?1N.N D
.I $D(^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2,0)) D
..S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"ALLERGY DD",PSJSUBS,PSJACNT2,0)=^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2,0)
Q
;
GETORD(PSJSUBS,PSJORDR,PSJTRUE) ;
I PSJORDR["U"!(PSJORDR["V") D
.I $D(PSJIEN70(100.11,"1,"_PSJSUBS_",",.01,"I")) S PSJRETI=PSJIEN70(100.11,"1,"_PSJSUBS_",",.01,"I") S:PSJORDR=($P(PSJRETI,";",2)_$P(PSJRETI,";")) PSJTRUE=1 Q
.I $D(PSJIEN70(100.07,"1,"_PSJSUBS_",",.01,"I")) S PSJRETI=PSJIEN70(100.07,"1,"_PSJSUBS_",",.01,"I") S:PSJORDR=($P(PSJRETI,";",2)_$P(PSJRETI,";")) PSJTRUE=1
I PSJORDR["P"!(PSJORDR["N") D
.I $D(PSJIEN60(100.517,"1,"_PSJSUBS_",",.01,"I")) S PSJRETI=PSJIEN60(100.517,"1,"_PSJSUBS_",",.01,"I") I PSJRETI["PS(53.1" S:+PSJORDR=$P(PSJRETI,";") PSJTRUE=1 Q
.I $D(PSJIEN60(100.07,"1,"_PSJSUBS_",",.01,"I")) S PSJRETI=PSJIEN60(100.07,"1,"_PSJSUBS_",",.01,"I") I PSJRETI["PS(53.1" S:+PSJORDR=$P(PSJRETI,";") PSJTRUE=1
Q PSJTRUE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJNEWOA 4908 printed Oct 16, 2024@18:08:36 Page 2
PSJNEWOA ;BIR/SAB - STORES BACKDOOR ORDER CHECKS IN FILE #100.05 ;11/08/2012
+1 ;;5.0;INPATIENT MEDICATIONS;**281**;16 DEC 97;Build 113
+2 ;External reference to ^TMP("PSODAOC",$J is supported by DBIA# 6071
+3 ;External reference to GETOC4^OROCAPI1 supported by DBIA 5729
+4 ;External reference to ^ORD(100.05 supported by DBIA 5731
+5 ;External reference to ^PS(55 supported by DBIA 2191
+6 ;
+7 ;Inpatient: When verifying order within the same session, pull allergies from non-verified order to verified order
+8 ;called from VF1^PSJLIACT and PSJHL3
VF ;unit dose or pending
+1 if '$GET(^TMP("PSODAOC",$JOB,"IP IEN"))
QUIT
+2 NEW PSJORET,PSJZORN,RXORDER,PSJDGVER,PSJOORD,ON55
+3 SET (PSJZORN,PSJORET,PSJOORD,PSJORET)=""
SET PSJDGVER=1
SET PSJOORD=$GET(^TMP("PSODAOC",$JOB,"IP IEN"))
+4 IF $GET(PSJSPEED)
SET PSJOORD=$GET(ON55)
+5 SET (ON55,RXORDER)=$GET(^TMP("PSODAOC",$JOB,"IP NEW IEN"))
+6 DO VF2
+7 QUIT
VF1 ;IV or edit
+1 NEW PSJDGORD,PSJORET,PSJZORN,RXORDER,ON55
+2 IF $GET(PSIVCOPY)
IF ($GET(ON55)["V")
KILL ^TMP("PSODAOC",$JOB,"ALLERGY")
+3 SET (PSJZORN,PSJORET)=""
SET (ON55,RXORDER)=$GET(^TMP("PSODAOC",$JOB,"IP NEW IEN"))
+4 SET PSJDGORD=$GET(^TMP("PSODAOC",$JOB,"IP IEN"))
VF2 ;
+1 IF $GET(PSJDGVER)&($GET(PSJOORD))
Begin DoDot:1
+2 IF PSJOORD["P"!(PSJOORD["N")
SET PSJZORN=+$PIECE(^PS(53.1,+PSJOORD,0),U,21)
QUIT
End DoDot:1
+3 ;
+4 IF '$GET(PSJREN)&('$GET(PSJDGVER))&($GET(PSJDGORD))
Begin DoDot:1
+5 IF PSJDGORD["P"!(PSJDGORD["N")
SET PSJZORN=+$PIECE($GET(^PS(53.1,+PSJDGORD,0)),U,21)
QUIT
+6 SET PSJZORN=$SELECT(PSJDGORD["V":$PIECE($GET(^PS(55,DFN,"IV",+PSJDGORD,0)),"^",21),PSJDGORD["U":$PIECE($GET(^PS(55,DFN,5,+PSJDGORD,0)),"^",21),1:"")
End DoDot:1
+7 IF $GET(PSJREN)&('$GET(PSJDGVER))&($GET(PSJDGORD))
SET PSJZORN=$SELECT(PSJDGORD["V":$PIECE($GET(^PS(55,DFN,"IV",+PSJDGORD,0)),"^",21),PSJDGORD["U":$PIECE($GET(^PS(55,DFN,5,+PSJDGORD,0)),"^",21),1:"")
+8 if 'PSJZORN
QUIT
+9 DO GETOC4^OROCAPI1(PSJZORN,.PSJORET)
+10 IF $ORDER(PSJORET(PSJZORN,"DATA",""))=""
KILL ^TMP("PSODAOC",$JOB)
QUIT
+11 ;
VF3 ;
+1 NEW PSJZI,PSJZIIEN,PSJNRET,PSJACNT,PSJACNT1,PSJACNT2,PSJIEN60,PSJIEN70,PSJRETI,PSJDFLAG,PSJZERO,PSOZH,PSJOZI
+2 SET (PSJACNT,PSJACNT1)=0
+3 FOR PSJZI=0:0
SET PSJZI=$ORDER(PSJORET(PSJZORN,"DATA",PSJZI))
if 'PSJZI
QUIT
IF $DATA(PSJORET(PSJZORN,"DATA",PSJZI,1))
Begin DoDot:1
+4 if +$PIECE(PSJORET(PSJZORN,"DATA",PSJZI,1),";",2)'=3
QUIT
+5 KILL PSJAIENS
+6 IF $GET(PSJOZI)'=PSJZI
SET PSJZIIEN=0
+7 SET PSJOZI=PSJZI
SET PSJACNT=PSJACNT+1
+8 FOR
SET PSJZIIEN=$ORDER(^ORD(100.05,PSJZI,4,PSJZIIEN))
if PSJZIIEN=""
QUIT
IF $DATA(^ORD(100.05,PSJZI,4,PSJZIIEN,0))
Begin DoDot:2
+9 if $PIECE(^ORD(100.05,PSJZI,0),"^",3)["CPRS"
QUIT
+10 DO GETS^DIQ(100.05,PSJZI,"60*","I","PSJIEN60")
DO GETS^DIQ(100.05,PSJZI,"70*","I","PSJIEN70")
+11 SET PSJDFLAG=""
SET PSJDFLAG=$$GETORD(PSJZI,$SELECT($GET(PSJDGVER):$GET(PSJOORD),1:PSJDGORD),PSJDFLAG)
+12 if '$GET(PSJDFLAG)
QUIT
+13 ;
+14 SET PSJACNT1=PSJACNT1+1
+15 SET ^TMP("PSODAOC",$JOB,"ALLERGY",PSJACNT,"ALLERGY PKG")="IP^"_$SELECT($GET(PSJOCFG)]"":$PIECE(PSJOCFG," ")_" ",1:"")_"^"_ON55_"^"_PSJZORN
+16 ;S:$D(^ORD(100.05,PSJZI,8)) ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"INTERVENTION")=^ORD(100.05,PSJZI,8)
+17 SET ^TMP("PSODAOC",$JOB,"ALLERGY","PROVR")=$GET(PSJORET(PSJZI,"DATA",PSJZIIEN,"OR",1,0))
+18 ;
+19 DO SETTMP
End DoDot:2
End DoDot:1
+20 ;
VF4 ;
+1 SET PSOZH="Allergy"
SET RXORDER=ON55
SET PSJAOC1=1
+2 SET (ON55,RXORDER)=$GET(^TMP("PSODAOC",$JOB,"IP NEW IEN"))
+3 IF $DATA(^TMP("PSODAOC",$JOB,"ALLERGY"))
DO VF2^PSJNEWOC
+4 KILL ^TMP("PSODAOC",$JOB,"ALLERGY")
+5 QUIT
+6 ;
SETTMP ;
+1 NEW PSJSUBS,PSJACNT2
+2 SET ^TMP("PSODAOC",$JOB,"ALLERGY",PSJACNT,4,PSJZIIEN,0)=$GET(^ORD(100.05,PSJZI,4,PSJZIIEN,0))
+3 ;
+4 IF $DATA(^ORD(100.05,PSJZI,4,PSJZIIEN,1,0))
SET PSJSUBS=1
DO SET1
+5 IF $DATA(^ORD(100.05,PSJZI,4,PSJZIIEN,2,0))
SET PSJSUBS=2
DO SET1
+6 IF $DATA(^ORD(100.05,PSJZI,4,PSJZIIEN,3,0))
SET PSJSUBS=3
DO SET1
+7 IF $DATA(^ORD(100.05,PSJZI,5,0))
SET PSJSUBS=5
DO SET2
+8 IF $DATA(^ORD(100.05,PSJZI,11,0))
SET ^TMP("PSODAOC",$JOB,"ALLERGY",PSJACNT,"PHARM")=^ORD(100.05,PSJZI,11,0)
+9 ;WILL NEED TO SET PHARM INFO 100.05
+10 QUIT
+11 ;
SET1 ;
+1 FOR PSJACNT2=0:0
SET PSJACNT2=$ORDER(^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2))
if PSJACNT2'?1N.N
QUIT
Begin DoDot:1
+2 IF $DATA(^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2,0))
Begin DoDot:2
+3 SET ^TMP("PSODAOC",$JOB,"ALLERGY",PSJACNT,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)=^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
SET2 ;
+1 FOR PSJACNT2=0:0
SET PSJACNT2=$ORDER(^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2))
if PSJACNT2'?1N.N
QUIT
Begin DoDot:1
+2 IF $DATA(^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2,0))
Begin DoDot:2
+3 SET ^TMP("PSODAOC",$JOB,"ALLERGY",PSJACNT,"ALLERGY DD",PSJSUBS,PSJACNT2,0)=^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2,0)
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
GETORD(PSJSUBS,PSJORDR,PSJTRUE) ;
+1 IF PSJORDR["U"!(PSJORDR["V")
Begin DoDot:1
+2 IF $DATA(PSJIEN70(100.11,"1,"_PSJSUBS_",",.01,"I"))
SET PSJRETI=PSJIEN70(100.11,"1,"_PSJSUBS_",",.01,"I")
if PSJORDR=($PIECE(PSJRETI,";",2)_$PIECE(PSJRETI,";"))
SET PSJTRUE=1
QUIT
+3 IF $DATA(PSJIEN70(100.07,"1,"_PSJSUBS_",",.01,"I"))
SET PSJRETI=PSJIEN70(100.07,"1,"_PSJSUBS_",",.01,"I")
if PSJORDR=($PIECE(PSJRETI,";",2)_$PIECE(PSJRETI,";"))
SET PSJTRUE=1
End DoDot:1
+4 IF PSJORDR["P"!(PSJORDR["N")
Begin DoDot:1
+5 IF $DATA(PSJIEN60(100.517,"1,"_PSJSUBS_",",.01,"I"))
SET PSJRETI=PSJIEN60(100.517,"1,"_PSJSUBS_",",.01,"I")
IF PSJRETI["PS(53.1"
if +PSJORDR=$PIECE(PSJRETI,";")
SET PSJTRUE=1
QUIT
+6 IF $DATA(PSJIEN60(100.07,"1,"_PSJSUBS_",",.01,"I"))
SET PSJRETI=PSJIEN60(100.07,"1,"_PSJSUBS_",",.01,"I")
IF PSJRETI["PS(53.1"
if +PSJORDR=$PIECE(PSJRETI,";")
SET PSJTRUE=1
End DoDot:1
+7 QUIT PSJTRUE
