- 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 Feb 18, 2025@23:57:53 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