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

PSONEWOA.m

Go to the documentation of this file.
PSONEWOA ;BIR/SAB-STORES ALLERGY ORDER CHECKS IN FILE #100.05 ;11/08/2012
 ;;7.0;OUTPATIENT PHARMACY;**411**;DEC 1997;Build 95
 ;External Reference to ^PS(53.1 supported by DBIA 5793 
 ;External Reference to ^DD("DD" supported by DBIA #999
 ;External Reference to SAVEOC^OROCAPI1 supported by DBIA 5729
 ;
DAOC ;stores drug allergies w/sign/symptoms
 N DACNT,DIC,DIE,DR,DA,DD,DO,PSORDIEN,PACKAGE,RXORDER,PSJOCFG,PSOJORD,PSOGORD,PSJDATA,ORN,RET,OORDIEN,ORL,ZERO,PSOALGCT
 ;SET THE 1, 2 AND 3 NODES OF 100.05
 S PSOALGCT=0 F  S PSOALGCT=$O(^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT)) Q:'PSOALGCT  D DAOC2
 K DR,DA,DIE,DIC,RET
 Q
DAOC2 ;
 K RET,ORL,DR,DA,DIE,DIC
 D LBL
 S OCCDT=$$NOW^XLFDT
 I PACKAGE="OP" S (OORDIEN,PSORDIEN,ORN)=$P(^PSRX(RXN,"OR1"),"^",2)
 I PACKAGE="IP" S ORN=PSORDIEN
 I '$G(ORN) D:PACKAGE="OP"  Q
 .N ZZIR,ZZFDA
 .S ZZIR=0 F ZZFDA=0:0 S ZZFDA=$O(^PSRX(RXN,"A",ZZFDA)) Q:'ZZFDA  S ZZIR=ZZFDA
 .S ZZIR=ZZIR+1,^PSRX(RXN,"A",0)="^52.3DA^"_ZZIR_"^"_ZZIR
 .D NOW^%DTC S ^PSRX(RXN,"A",ZZIR,0)=%_"^S^"_DUZ_"^0^"_"CPRS Order Number is not defined.  Cannot store order check information in the activity log."
 I $G(PSJAOC1) D
 .S:'$D(PSJDAOC) PSJDAOC="IP "_$S($G(PSJOCFG)]"":PSJOCFG,1:"DRUG ALLERGY")
 .S ORL(1,1)=+ORN_"^"_PSJDAOC_""_"^"_DUZ_"^"_OCCDT_"^3^"
 I '$G(PSJAOC1) S ORL(1,1)=PSORDIEN_"^"_PSODAOC_"^"_DUZ_"^"_OCCDT_"^3^"
 S ORL(1,3)=^TMP("PSODAOC",$J,"ALLERGY","PROVR")
 S ORL(1,2,1)="A Drug-Allergy Reaction exists for this medication and/or class."
 D SAVEOC^OROCAPI1(.ORL,.RET)
 Q:'$D(RET)
 S (PSORDIEN,DA)=$O(RET(1,0))
 I $G(DA) S DIE="^ORD(100.05,",DR="84///V" D ^DIE K DA,DIE
 D DISP
 ;SET 4 AND 5 NODES OF 100.05
 S DACNT=0 F  S DACNT=$O(^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,4,DACNT)) Q:'DACNT  D DAOC1 K DA,DR,DIE,DIC
 I RXORDER["P"!(RXORDER["N")!(RXORDER["O") D GRP1
 I RXORDER["V"!(RXORDER["U") D GRP2
 K DA,RET,DR
 Q
 ;
DAOC1 ;
 N OCCDT,Z,RET,NODE,PSOREACT,PSOORDT,PSOLRTP,PSOHO,PSOSEV,PSOREML,PSOCAUSA,Y K DA,DIC,DIE,DR
 S ZERO=$G(^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,4,DACNT,0))
 S:$P(ZERO,"^",3)="L" $P(ZERO,"^",4)=""  ;If location is local don't store location #
 Q:ZERO=""
 S DA(1)=PSORDIEN Q:'DA(1)
 S DA=$O(^ORD(100.05,DA(1),4,9999),-1)+1
 S X=$P(ZERO,"^"),DIC="^ORD(100.05,"_DA(1)_",4,",DIC(0)="Z" D FILE^DICN
 K DA,DIE,DR,DIC
 S DIE="^ORD(100.05,"_PSORDIEN_",4,",DA=DACNT,DA(1)=4,DA(2)=PSORDIEN
 S PSOREACT=$P($P(ZERO,"^"),"|"),Y=$P(ZERO,"^",5) X ^DD("DD") S:Y'=-1 PSORDT=Y
 S PSOLRTP=$P(ZERO,"^",3),PSOHO=$P(ZERO,"^",6),PSOSEV=$P(ZERO,"^",7)
 S DR=".01///"_PSOREACT_";8///"_PSORDT_";6///"_PSOLRTP_";9///"_PSOHO_";10///"_PSOSEV
 ; DR=".01///PENICILLIN;8///OCT 27,2014@13:22;6///L;9///H;10///;7///ALBANY"
 S:$P(ZERO,"^",4)'="" PSOREML=$$GET1^DIQ(4,$P(ZERO,"^",4),.01),DR=DR_";7///"_PSOREML
 D ^DIE
 K DR
 S FDA(100.517,DA_","_DA(2)_",",2)=$P(ZERO,"^",2)  ;variable pointer for causative agent
 D UPDATE^DIE("","FDA")
 F NODE=1:1:3 D SET
 ; This sets up for GRP1 Filing below
 I $G(PSOARENW)=1!($G(ZNEW)=1)!($G(PSOREINS)=1)!($G(PSOREINO))!($G(PSONV)) S RXORDER=ZRXN_"O"  ;Results in RX IEN_OP
 I $G(PSOORNEW)=1!($G(ZFRENEW)=1) S RXORDER=$G(RXN)_"O"
 Q
 ;
SET ;
 N PSOCNT,DA,DIE,DR,DIC,DINUM,X,XX,LAYGO
 S DA(2)=PSORDIEN,DA(1)=DACNT,LAYGO=100.517,PSOCNT=0
 S DIC="^ORD(100.05,"_PSORDIEN_",4,"_DACNT_","_NODE_",",DIC(0)="LZ"
 F  S PSOCNT=$O(^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,4,DACNT,NODE,PSOCNT)) Q:PSOCNT=""  I PSOCNT'="" S X="",X=^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,4,DACNT,NODE,PSOCNT,0) D
 .Q:X=""
 .S (DA,DINUM)=$O(^ORD(100.05,PSORDIEN,4,DACNT,NODE,9999),-1)+1
 .;GET THE EXTERNAL VALUE TO SEND THROUGH FILEMAN
 .I NODE=1 S XX=$$GET1^DIQ(50.605,X,.01)  ;DRUG CLASS
 .I NODE=2 S XX=$$GET1^DIQ(50.416,X,.01)  ;INGREDIENT
 .I NODE=3 S XX=$$GET1^DIQ(120.83,X,.01)  ;SIGN/SYMPTON
 .S DR=".01///"_XX
 .D FILE^DICN K DD,DO
 Q
 ;
DISP ;
 I '$G(PSORDIEN) S PSORDIEN=OORDIEN
 Q:'$G(PSORDIEN)
 N DIC,DA,DR,PSOCNT,PSOINT  ; DISPENSE DRUGS
 S PSOCNT=0 F  S PSOCNT=$O(^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,"ALLERGY DD",5,PSOCNT)) Q:PSOCNT=""  S X=^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,"ALLERGY DD",5,PSOCNT,0) D
 .Q:X=""
 .S DA(1)=PSORDIEN,DIC="^ORD(100.05,"_DA(1)_",5,",DIC(0)="Z"
 .D FILE^DICN
 ;
 I $D(^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,"INTERVENTION")) D  Q
 .K DA,DIC,DIE,DR
 .S (DIC,DIE)="^ORD(100.05,",DIC(0)="F",DA=PSORDIEN
 .S X=^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,"INTERVENTION")
 .Q:X=""
 .S DR="81///"_X
 .D ^DIE
 ;^TMP("PSODAOC",539222232,1,"INTERVENTION")=6067
 Q
 ;
LBL ;
 S PACKAGE=$G(^TMP("PSODAOC",$J,"ALLERGY",PSOALGCT,"ALLERGY PKG"))
 I PACKAGE="IP" S PACKAGE=$G(^TMP("PSODAOC",$J,"ALLERGY","ALLERGY PKG"))
 S RXORDER=$P(PACKAGE,"^",3),PSJOCFG=$P(PACKAGE,"^",2),PSORDIEN=$P(PACKAGE,"^",4),PACKAGE=$P(PACKAGE,"^")
 I PACKAGE="OP" N PSOVRSTA S PSOVRSTA=0 D
 .S:$D(ZRXN) RXN=ZRXN
 .S PSODAOC="OP " D
 ..I $P(PSOPAR,"^",2) S:$G(RXN) PSOVRSTA=$P($G(^PSRX(RXN,"STA")),"^") D
 ...I $D(^XUSEC("PSORPH",DUZ)) S PSODAOC=PSODAOC_"RPh Verified " Q
 ...S PSODAOC=PSODAOC_"Tech Non-Verified "
 ..S PSODAOC=PSODAOC_$S($G(PSOFOERR):"FINISH",$G(ZZEDIT):"EDIT",$G(ZZCOPY):"COPY",$G(PSOREINS)!($G(PSOREINO)):"REINSTATE",$G(PSOARENW)=1:"RENEW",$G(PSONV):"VERIFY",1:"NEW")
 I PACKAGE="IP" D
 .S:$D(ZRXN) RXN=ZRXN
 .S PSORDIEN=$S(RXORDER["P"!(RXORDER["N"):+$$GET1^DIQ(53.1,+RXORDER,49),RXORDER["U":$$GET1^DIQ(55.06,+RXORDER_","_DFN_",",66),RXORDER["V":$$GET1^DIQ(55.01,+RXORDER_","_DFN_",",110),1:-1)
 .I PSORDIEN="",$D(^PS(53.1,RXORDER,0)) S PSORDIEN=+$$GET1^DIQ(53.1,+RXORDER,49)
 .; -- RTC 220104 - Replace: "IP DRUG  With: "DRUG
 .S:'$D(PSJDAOC) PSJDAOC="IP "_$S($G(PSJOCFG)]"":PSJOCFG,1:"DRUG ALLERGY")
 Q
 ;
GRP1 ;
 ; #60 - GROUP ONE PHARMACY ORDERS^100.07VA^^6;0
 ; OP PENDING ORDERS - IEN;PS(52.41,
 ; IP RX - IEN;PS(53.1,
 ; OP RX - IEN;PSRX(
 ;
 N ZORT,X,ZX
 S ZX=0,DA(1)=PSORDIEN Q:'DA(1)
 I $G(RXORDER)["N"!($G(RXORDER)["P") S ZORT=+RXORDER_";PS(53.1,"
 I $G(RXORDER)["O" S ZORT=+RXORDER_";PSRX("
 ;S ZORT=+RXORDER_";PS(53.1,"
 S X=ZORT,DIC="^ORD(100.05,"_DA(1)_",6,",DIC(0)="Z"
 D FILE^DICN
 K DIC
 S ODA(1)=DA(1)
 Q
 ;
GRP2 ;
 ;GROUP TWO PHARMACY ORDER FIELD (#70)
 ;Data is formatted as follows:
 ;"N;ien" => Non-VA Medications  ^PS(55,DFN,"NVA",ien)
 ;"R;rx#" => Remote Outpatient   ^PSRX(ien  Prescription Number
 ;
 N PSORIEN,PSORSITI,PSORSITE,ZORT,X,ZX
 S DA(1)=PSORDIEN Q:'DA(1)
 S ZORT=$S(RXORDER["U":"U;"_+RXORDER,RXORDER["V":"V;"_+RXORDER,1:"")
 I $P(ZORT,";")="R" D
 .S PSORIEN=$P($P(ZORT,"^",1),";",2),PSORSITE=$P(ZORT,"^",2),PSORDRG=$P(ZORT,"^",5)
 .S:PSORSITE'="" PSORSITI=$O(^DIC(4,"B",PSORSITE,PSORSITI))
 .S ZORT="R;"_PSORIEN_"^"_PSORSITI
 K DIC
 S X=ZORT,DIC="^ORD(100.05,"_DA(1)_",7,",DIC(0)="Z"
 D FILE^DICN
 K DIC
 Q