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