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