Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJNEWOA

PSJNEWOA.m

Go to the documentation of this file.
  1. 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
  1. ;External reference to ^TMP("PSODAOC",$J is supported by DBIA# 6071
  1. ;External reference to GETOC4^OROCAPI1 supported by DBIA 5729
  1. ;External reference to ^ORD(100.05 supported by DBIA 5731
  1. ;External reference to ^PS(55 supported by DBIA 2191
  1. ;
  1. ;Inpatient: When verifying order within the same session, pull allergies from non-verified order to verified order
  1. ;called from VF1^PSJLIACT and PSJHL3
  1. VF ;unit dose or pending
  1. Q:'$G(^TMP("PSODAOC",$J,"IP IEN"))
  1. N PSJORET,PSJZORN,RXORDER,PSJDGVER,PSJOORD,ON55
  1. S (PSJZORN,PSJORET,PSJOORD,PSJORET)="",PSJDGVER=1,PSJOORD=$G(^TMP("PSODAOC",$J,"IP IEN"))
  1. I $G(PSJSPEED) S PSJOORD=$G(ON55)
  1. S (ON55,RXORDER)=$G(^TMP("PSODAOC",$J,"IP NEW IEN"))
  1. D VF2
  1. Q
  1. VF1 ;IV or edit
  1. N PSJDGORD,PSJORET,PSJZORN,RXORDER,ON55
  1. I $G(PSIVCOPY),($G(ON55)["V") K ^TMP("PSODAOC",$J,"ALLERGY")
  1. S (PSJZORN,PSJORET)="",(ON55,RXORDER)=$G(^TMP("PSODAOC",$J,"IP NEW IEN"))
  1. S PSJDGORD=$G(^TMP("PSODAOC",$J,"IP IEN"))
  1. VF2 ;
  1. I $G(PSJDGVER)&($G(PSJOORD)) D
  1. .I PSJOORD["P"!(PSJOORD["N") S PSJZORN=+$P(^PS(53.1,+PSJOORD,0),U,21) Q
  1. ;
  1. I '$G(PSJREN)&('$G(PSJDGVER))&($G(PSJDGORD)) D
  1. .I PSJDGORD["P"!(PSJDGORD["N") S PSJZORN=+$P($G(^PS(53.1,+PSJDGORD,0)),U,21) Q
  1. .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:"")
  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:"")
  1. Q:'PSJZORN
  1. D GETOC4^OROCAPI1(PSJZORN,.PSJORET)
  1. I $O(PSJORET(PSJZORN,"DATA",""))="" K ^TMP("PSODAOC",$J) Q
  1. ;
  1. VF3 ;
  1. N PSJZI,PSJZIIEN,PSJNRET,PSJACNT,PSJACNT1,PSJACNT2,PSJIEN60,PSJIEN70,PSJRETI,PSJDFLAG,PSJZERO,PSOZH,PSJOZI
  1. S (PSJACNT,PSJACNT1)=0
  1. F PSJZI=0:0 S PSJZI=$O(PSJORET(PSJZORN,"DATA",PSJZI)) Q:'PSJZI I $D(PSJORET(PSJZORN,"DATA",PSJZI,1)) D
  1. .Q:+$P(PSJORET(PSJZORN,"DATA",PSJZI,1),";",2)'=3
  1. .K PSJAIENS
  1. .I $G(PSJOZI)'=PSJZI S PSJZIIEN=0
  1. .S PSJOZI=PSJZI,PSJACNT=PSJACNT+1
  1. .F S PSJZIIEN=$O(^ORD(100.05,PSJZI,4,PSJZIIEN)) Q:PSJZIIEN="" I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,0)) D
  1. ..Q:$P(^ORD(100.05,PSJZI,0),"^",3)["CPRS"
  1. ..D GETS^DIQ(100.05,PSJZI,"60*","I","PSJIEN60"),GETS^DIQ(100.05,PSJZI,"70*","I","PSJIEN70")
  1. ..S PSJDFLAG="",PSJDFLAG=$$GETORD(PSJZI,$S($G(PSJDGVER):$G(PSJOORD),1:PSJDGORD),PSJDFLAG)
  1. ..Q:'$G(PSJDFLAG)
  1. ..;
  1. ..S PSJACNT1=PSJACNT1+1
  1. ..S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"ALLERGY PKG")="IP^"_$S($G(PSJOCFG)]"":$P(PSJOCFG," ")_" ",1:"")_"^"_ON55_"^"_PSJZORN
  1. ..;S:$D(^ORD(100.05,PSJZI,8)) ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"INTERVENTION")=^ORD(100.05,PSJZI,8)
  1. ..S ^TMP("PSODAOC",$J,"ALLERGY","PROVR")=$G(PSJORET(PSJZI,"DATA",PSJZIIEN,"OR",1,0))
  1. ..;
  1. ..D SETTMP
  1. ;
  1. VF4 ;
  1. S PSOZH="Allergy",RXORDER=ON55,PSJAOC1=1
  1. S (ON55,RXORDER)=$G(^TMP("PSODAOC",$J,"IP NEW IEN"))
  1. I $D(^TMP("PSODAOC",$J,"ALLERGY")) D VF2^PSJNEWOC
  1. K ^TMP("PSODAOC",$J,"ALLERGY")
  1. Q
  1. ;
  1. SETTMP ;
  1. N PSJSUBS,PSJACNT2
  1. S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,4,PSJZIIEN,0)=$G(^ORD(100.05,PSJZI,4,PSJZIIEN,0))
  1. ;
  1. I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,1,0)) S PSJSUBS=1 D SET1
  1. I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,2,0)) S PSJSUBS=2 D SET1
  1. I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,3,0)) S PSJSUBS=3 D SET1
  1. I $D(^ORD(100.05,PSJZI,5,0)) S PSJSUBS=5 D SET2
  1. I $D(^ORD(100.05,PSJZI,11,0)) S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"PHARM")=^ORD(100.05,PSJZI,11,0)
  1. ;WILL NEED TO SET PHARM INFO 100.05
  1. Q
  1. ;
  1. SET1 ;
  1. F PSJACNT2=0:0 S PSJACNT2=$O(^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2)) Q:PSJACNT2'?1N.N D
  1. .I $D(^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)) D
  1. ..S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)=^ORD(100.05,PSJZI,4,PSJZIIEN,PSJSUBS,PSJACNT2,0)
  1. Q
  1. ;
  1. SET2 ;
  1. F PSJACNT2=0:0 S PSJACNT2=$O(^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2)) Q:PSJACNT2'?1N.N D
  1. .I $D(^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2,0)) D
  1. ..S ^TMP("PSODAOC",$J,"ALLERGY",PSJACNT,"ALLERGY DD",PSJSUBS,PSJACNT2,0)=^ORD(100.05,PSJZI,PSJSUBS,PSJACNT2,0)
  1. Q
  1. ;
  1. GETORD(PSJSUBS,PSJORDR,PSJTRUE) ;
  1. I PSJORDR["U"!(PSJORDR["V") D
  1. .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
  1. .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
  1. I PSJORDR["P"!(PSJORDR["N") D
  1. .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
  1. .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
  1. Q PSJTRUE