PSONEWOC ;BIR/SAB-STORES BACKDOOR ORDER CHECKS IN FILE #100.05 ;11/08/2012
;;7.0;OUTPATIENT PHARMACY;**411**;DEC 1997;Build 95
;External reference to SAVEOC^OROCAPI1 supported by DBIA 5729
;External reference to ^ORD(100.05, supported by DBIA 5731
;
ACT ;store order checks
N PSOZH,PSOKIND,DA,DR,DIC,DIE S RXN=$O(^TMP("PSORXN",$J,0))
I $G(PSONV) S ZRXN=PSONV
;I $G(^TMP("PSODAOC",$J,"NORDI",1,0))]"" D NORDI^PSONEWO1
;I $D(^TMP("PSODAOC",$J,"DD")) S PSOKIND="DD",PSOZH="Duplicate Drug" D SET ;dup drug
I $D(^TMP("PSODAOC",$J,"ALLERGY")) S PSOZH="Order Allergy" D DAOC^PSONEWOA ;drug allergies
;I $G(^TMP("PSODAOC",$J,"CLOZ",0))]"" S PSOZH="Clozapine" D CLOZ^PSONEWO1
;I $D(^TMP("PSODAOC",$J,"DI",0))]"" S PSOKIND="DI",PSOZH="Drug Interaction" D SET ;drug interaction
;I $D(^TMP("PSODAOC",$J,"CROC")) D CROCLOG^PSOCROC
;I $D(^TMP("PSODAOC",$J,"DT")) S PSOKIND="DT",PSOZH="Duplicate Therapy" D SET ;dup drug therapy
;I $O(^TMP("PSODAOC",$J,"CPRS",0)) S PSOZH="Order Check" D CPRS^PSONEWO1 ;cprs order checks
;I $G(^TMP("PSODAOC",$J,"NOSYS",1,0))]"" D NOSYS^PSONEWO1 ;fdb down
;I $O(^TMP("PSODAOC",$J,"EXEC",0)) D EXEC^PSONEWO1 ;order chk execeptions
;I $O(^TMP("PSODAOC",$J,"DRG","ERROR",0))!($O(^TMP("PSODAOC",$J,"THP","ERROR",0))) D ERROR^PSONEWO1 ;order chk errors
;I $D(^TMP("PSODAOC",$J,"DOSE","ERROR")) D DERROR^PSONEWO1 ;dosing order chk errors
;I $O(^TMP("PSODAOC",$J,"DOSE","EXEC",0)) D DEXEC^PSONEWO1 ;dosing order chk exceptions
;I $O(^TMP("PSODAOC",$J,"DOSE","MSG",0)) D DMSG^PSONEWO1 ;dosing order chk messages
;I $G(^TMP("PSODAOC",$J,"DOSE NOSYS",1,0))]"" D NODSYS^PSONEWO1 ;dosing fdb down
K CT,IT,PSODAOC,I,PI,XZX,ZZCOPY,PSOZH
Q
;
SET ;DEFINED 100.05
N DA,DIC,DIE,OCCDT,ORN,ORL,RET,SEV,ZOC,ZZX,ZTOT,ZDRG,ZORT,ZCHK,ZCLZ,ZX,PSODAOCN,PSOSTYP,CLASS,CLASSIEN,STATUS,ODA,ZVA,PSORDRG,SEVERITY
S RXN=ZRXN
S PSODAOC=$$LBL(RXN)
S OCCDT=$$NOW^XLFDT,ORN=$P(^PSRX(RXN,"OR1"),"^",2),ZCLZ=""
;
S (ZCLZ,SEV,ZVA)="",ZX=0
F S SEV=$O(^TMP("PSODAOC",$J,PSOKIND,SEV)) Q:SEV=""!(SEV="Z") F S ZVA=$O(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA)) Q:ZVA="" D
.S (PSOSTYP,SEVERITY,IT,ODA)=""
.K DA,DIC,DIE
.I PSOKIND="DD" D S SEVERITY=16
..S PI=0,PSOSTYP=50 F S PSOSTYP=$O(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,PSOSTYP)) Q:PSOSTYP="" F S PI=$O(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,PSOSTYP,"CLASS",PI)) Q:'PI D
...S (CLASSIEN,CLASS)="",CLASS=^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,PSOSTYP,"CLASS",PI,0) ;,CLASSIEN=$O(^PS(50.605,"B",CLASS,CLASSIEN))
...S:CLASS'="" ZCLZ=ZCLZ_", "_CLASS
..S ZCLZ=$E(ZCLZ,3,999)
.I PSOKIND="DI" D
..S IT=$G(^TMP("PSODAOC",$J,"DI","Z","INT")),SEVERITY=$S(SEV="C":18,1:31)
.K DA,RET,ORL
.I PSOKIND="DT" S SEVERITY=17
.S ORL(1,1)=ORN_"^"_$S($D(PSJDAOC):PSJDAOC,1:PSODAOC)_"^"_DUZ_"^"_OCCDT_"^"_SEVERITY
.S ORL(1,2,1)=PSOZH_" exists for this medication." S:PSOKIND="DD" ORL(1,2,1)=ORL(1,2,1)_$S(ZCLZ'="":"["_ZCLZ_"]",1:"") K ZCLZ
.D SAVEOC^OROCAPI1(.ORL,.RET)
.S DA=$O(RET(1,0)) Q:'DA
.S:ODA'=DA ODA=DA
.;S STATUS="",STATUS=$$GET1^DIQ(52,RXN,100,"I")
.S DR="1///6"
.S:$G(IT) DR=DR_";81///"_IT
.S DIE="^ORD(100.05,",DR=DR_$S(PSOKIND="DI":";83///"_SEV_";84///C",PSOKIND="DD":";84///V",1:";84///C")
.I $E(DR,1)=";" S DR=$E(DR,2,999)
.D ^DIE
.D SET2
K DR
Q
;
SET2 ;
; #50 - DISPENSE DRUGS^100.06PA^^5;0
I $D(^TMP("PSODAOC",$J,PSOKIND,ZVA,50)) S X="",X=$O(^TMP("PSODAOC",$J,PSOKIND,ZVA,50,X)) D
.K DIC,DIE
.S DA(1)=DA,DIC="^ORD(100.05,"_DA(1)_",5,",DIC(0)="Z"
.D FILE^DICN K X
;
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(
S ZX=0
F S ZX=$O(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,60,ZX)) Q:'ZX!(ZX="CL") D
.S ZORT="",ZORT=^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,60,ZX,0)
.S DA(1)=DA,X=ZORT,DIC="^ORD(100.05,"_DA(1)_",6,",DIC(0)="Z"
.D FILE^DICN
.K DIC
.S ODA(1)=DA(1)
.;I $D(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,60,"CL")) S PSODAOCN=60 D CLINEFF S DA=ODA,DA(1)=ODA(1)
;
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
S ZX=0 F S ZX=$O(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,70,ZX)) Q:'ZX!(ZX="CL") D
.S ZORT="",ZORT=^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,70,ZX,0)
.N PSORIEN,PSORSITI,PSORSITE
.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 DA(1)=DA,X=ZORT,DIC="^ORD(100.05,"_DA(1)_",7,",DIC(0)="Z"
.D FILE^DICN
.K DIC
.;I $D(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,70,"CL")) S PSODAOCN=70 D CLINEFF S DA=ODA,DA(1)=ODA(1)
;Q
;
CLINEFF ;clinical effects
N PSOFILE,PSOIENS,PSOCLEFF,DIWL,DIWR,DIWF,DINUM,DR,OLDX,OLD
Q:'$D(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,"CL"))
K DIC,^UTILITY($J,"W")
S DIWL=1,DIWR=78,DIWF="",(DINUM,PSOCLEFF,OLDX)=""
I SEV="S" S X="*** Refer to MONOGRAPH for SIGNIFICANT INTERACTION CLINICAL EFFECTS" D ^DIWP G CLINEFF1
F S PSOCLEFF=$O(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,"CL",PSOCLEFF)) Q:PSOCLEFF="" D S OLDX=X
.S X="",X=^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,"CL",PSOCLEFF,0) I X'=OLDX D ^DIWP
CLINEFF1 ;
S X="",DIC="^ORD(100.05,"_DA(1)_",10,",DIC(0)="Z"
S (DA,DINUM)=$O(^ORD(100.05,DA(1),10,9999),-1)+1
D FILE^DICN
K DIC,DIE,DR
S PSOFILE=100.05,PSOCLEFF="",PSOCLEFF=$NA(^UTILITY($J,"W",1))
D WP^DIE(PSOFILE,DA(1),100,"A",PSOCLEFF,"PSOER")
K ^UTILITY($J,"W")
;
;for some strange reason if you put the following code before CLINEFF the clinical effects aren't stored.
K DIC,DIE,DIR,DA
S DA=ODA
I $P(ZORT,";")="R" D
.S DIE="^ORD(100.05,"_DA_",7,",DA(2)=DA,DA(1)=7,DR="2///"_PSORSITI
.S DA=99999,DA=$O(^ORD(100.05,DA(2),7,DA),-1)
.D ^DIE
Q
;
LBL(RXN) ;
;Q "OP "_$S($G(ZZVER):"Verification ",$G(ZFRENEW):"CPRS RENEWAL ",$G(ZZEDIT):"EDIT ",$G(ZZCOPY):"COPY ",$G(PSOREINS):"REINSTATE ",$P(^PSRX(RXN,"STA"),"^")=1:"NON-VERIFIED ",$G(PSOARENW)=1:"RENEWAL ",1:"NEW ")_$G(PSOZH)
LBL2 ;
N TEXT
S TEXT="",TEXT="OP "_$S('$D(^XUSEC("PSORPH",DUZ))&($P(^PSRX(RXN,"STA"),"^")):"Non-Verified ",$D(^XUSEC("PSORPH",DUZ))&($G(ZZVER)):"RPh Verification ",1:"")
S TEXT=TEXT_$S($G(ZFRENEW):"CPRS RENEWAL ",$G(ZZEDIT):"EDIT ",$G(ZZCOPY):"COPY ",$G(PSOREINS):"REINSTATE ",$G(PSOARENW)=1:"RENEWAL ",1:"NEW ")
Q TEXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSONEWOC 6429 printed Apr 09, 2024@21:27:12 Page 2
PSONEWOC ;BIR/SAB-STORES BACKDOOR ORDER CHECKS IN FILE #100.05 ;11/08/2012
+1 ;;7.0;OUTPATIENT PHARMACY;**411**;DEC 1997;Build 95
+2 ;External reference to SAVEOC^OROCAPI1 supported by DBIA 5729
+3 ;External reference to ^ORD(100.05, supported by DBIA 5731
+4 ;
ACT ;store order checks
+1 NEW PSOZH,PSOKIND,DA,DR,DIC,DIE
SET RXN=$ORDER(^TMP("PSORXN",$JOB,0))
+2 IF $GET(PSONV)
SET ZRXN=PSONV
+3 ;I $G(^TMP("PSODAOC",$J,"NORDI",1,0))]"" D NORDI^PSONEWO1
+4 ;I $D(^TMP("PSODAOC",$J,"DD")) S PSOKIND="DD",PSOZH="Duplicate Drug" D SET ;dup drug
+5 ;drug allergies
IF $DATA(^TMP("PSODAOC",$JOB,"ALLERGY"))
SET PSOZH="Order Allergy"
DO DAOC^PSONEWOA
+6 ;I $G(^TMP("PSODAOC",$J,"CLOZ",0))]"" S PSOZH="Clozapine" D CLOZ^PSONEWO1
+7 ;I $D(^TMP("PSODAOC",$J,"DI",0))]"" S PSOKIND="DI",PSOZH="Drug Interaction" D SET ;drug interaction
+8 ;I $D(^TMP("PSODAOC",$J,"CROC")) D CROCLOG^PSOCROC
+9 ;I $D(^TMP("PSODAOC",$J,"DT")) S PSOKIND="DT",PSOZH="Duplicate Therapy" D SET ;dup drug therapy
+10 ;I $O(^TMP("PSODAOC",$J,"CPRS",0)) S PSOZH="Order Check" D CPRS^PSONEWO1 ;cprs order checks
+11 ;I $G(^TMP("PSODAOC",$J,"NOSYS",1,0))]"" D NOSYS^PSONEWO1 ;fdb down
+12 ;I $O(^TMP("PSODAOC",$J,"EXEC",0)) D EXEC^PSONEWO1 ;order chk execeptions
+13 ;I $O(^TMP("PSODAOC",$J,"DRG","ERROR",0))!($O(^TMP("PSODAOC",$J,"THP","ERROR",0))) D ERROR^PSONEWO1 ;order chk errors
+14 ;I $D(^TMP("PSODAOC",$J,"DOSE","ERROR")) D DERROR^PSONEWO1 ;dosing order chk errors
+15 ;I $O(^TMP("PSODAOC",$J,"DOSE","EXEC",0)) D DEXEC^PSONEWO1 ;dosing order chk exceptions
+16 ;I $O(^TMP("PSODAOC",$J,"DOSE","MSG",0)) D DMSG^PSONEWO1 ;dosing order chk messages
+17 ;I $G(^TMP("PSODAOC",$J,"DOSE NOSYS",1,0))]"" D NODSYS^PSONEWO1 ;dosing fdb down
+18 KILL CT,IT,PSODAOC,I,PI,XZX,ZZCOPY,PSOZH
+19 QUIT
+20 ;
SET ;DEFINED 100.05
+1 NEW DA,DIC,DIE,OCCDT,ORN,ORL,RET,SEV,ZOC,ZZX,ZTOT,ZDRG,ZORT,ZCHK,ZCLZ,ZX,PSODAOCN,PSOSTYP,CLASS,CLASSIEN,STATUS,ODA,ZVA,PSORDRG,SEVERITY
+2 SET RXN=ZRXN
+3 SET PSODAOC=$$LBL(RXN)
+4 SET OCCDT=$$NOW^XLFDT
SET ORN=$PIECE(^PSRX(RXN,"OR1"),"^",2)
SET ZCLZ=""
+5 ;
+6 SET (ZCLZ,SEV,ZVA)=""
SET ZX=0
+7 FOR
SET SEV=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,SEV))
if SEV=""!(SEV="Z")
QUIT
FOR
SET ZVA=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA))
if ZVA=""
QUIT
Begin DoDot:1
+8 SET (PSOSTYP,SEVERITY,IT,ODA)=""
+9 KILL DA,DIC,DIE
+10 IF PSOKIND="DD"
Begin DoDot:2
+11 SET PI=0
SET PSOSTYP=50
FOR
SET PSOSTYP=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,PSOSTYP))
if PSOSTYP=""
QUIT
FOR
SET PI=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,PSOSTYP,"CLASS",PI))
if 'PI
QUIT
Begin DoDot:3
+12 ;,CLASSIEN=$O(^PS(50.605,"B",CLASS,CLASSIEN))
SET (CLASSIEN,CLASS)=""
SET CLASS=^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,PSOSTYP,"CLASS",PI,0)
+13 if CLASS'=""
SET ZCLZ=ZCLZ_", "_CLASS
End DoDot:3
+14 SET ZCLZ=$EXTRACT(ZCLZ,3,999)
End DoDot:2
SET SEVERITY=16
+15 IF PSOKIND="DI"
Begin DoDot:2
+16 SET IT=$GET(^TMP("PSODAOC",$JOB,"DI","Z","INT"))
SET SEVERITY=$SELECT(SEV="C":18,1:31)
End DoDot:2
+17 KILL DA,RET,ORL
+18 IF PSOKIND="DT"
SET SEVERITY=17
+19 SET ORL(1,1)=ORN_"^"_$SELECT($DATA(PSJDAOC):PSJDAOC,1:PSODAOC)_"^"_DUZ_"^"_OCCDT_"^"_SEVERITY
+20 SET ORL(1,2,1)=PSOZH_" exists for this medication."
if PSOKIND="DD"
SET ORL(1,2,1)=ORL(1,2,1)_$SELECT(ZCLZ'="":"["_ZCLZ_"]",1:"")
KILL ZCLZ
+21 DO SAVEOC^OROCAPI1(.ORL,.RET)
+22 SET DA=$ORDER(RET(1,0))
if 'DA
QUIT
+23 if ODA'=DA
SET ODA=DA
+24 ;S STATUS="",STATUS=$$GET1^DIQ(52,RXN,100,"I")
+25 SET DR="1///6"
+26 if $GET(IT)
SET DR=DR_";81///"_IT
+27 SET DIE="^ORD(100.05,"
SET DR=DR_$SELECT(PSOKIND="DI":";83///"_SEV_";84///C",PSOKIND="DD":";84///V",1:";84///C")
+28 IF $EXTRACT(DR,1)=";"
SET DR=$EXTRACT(DR,2,999)
+29 DO ^DIE
+30 DO SET2
End DoDot:1
+31 KILL DR
+32 QUIT
+33 ;
SET2 ;
+1 ; #50 - DISPENSE DRUGS^100.06PA^^5;0
+2 IF $DATA(^TMP("PSODAOC",$JOB,PSOKIND,ZVA,50))
SET X=""
SET X=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,ZVA,50,X))
Begin DoDot:1
+3 KILL DIC,DIE
+4 SET DA(1)=DA
SET DIC="^ORD(100.05,"_DA(1)_",5,"
SET DIC(0)="Z"
+5 DO FILE^DICN
KILL X
End DoDot:1
+6 ;
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 SET ZX=0
+6 FOR
SET ZX=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,60,ZX))
if 'ZX!(ZX="CL")
QUIT
Begin DoDot:1
+7 SET ZORT=""
SET ZORT=^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,60,ZX,0)
+8 SET DA(1)=DA
SET X=ZORT
SET DIC="^ORD(100.05,"_DA(1)_",6,"
SET DIC(0)="Z"
+9 DO FILE^DICN
+10 KILL DIC
+11 SET ODA(1)=DA(1)
+12 ;I $D(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,60,"CL")) S PSODAOCN=60 D CLINEFF S DA=ODA,DA(1)=ODA(1)
End DoDot:1
+13 ;
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 SET ZX=0
FOR
SET ZX=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,70,ZX))
if 'ZX!(ZX="CL")
QUIT
Begin DoDot:1
+6 SET ZORT=""
SET ZORT=^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,70,ZX,0)
+7 NEW PSORIEN,PSORSITI,PSORSITE
+8 IF $PIECE(ZORT,";")="R"
Begin DoDot:2
+9 SET PSORIEN=$PIECE($PIECE(ZORT,"^",1),";",2)
SET PSORSITE=$PIECE(ZORT,"^",2)
SET PSORDRG=$PIECE(ZORT,"^",5)
+10 if PSORSITE'=""
SET PSORSITI=$ORDER(^DIC(4,"B",PSORSITE,PSORSITI))
+11 SET ZORT="R;"_PSORIEN_"^"_PSORSITI
End DoDot:2
+12 KILL DIC
+13 SET DA(1)=DA
SET X=ZORT
SET DIC="^ORD(100.05,"_DA(1)_",7,"
SET DIC(0)="Z"
+14 DO FILE^DICN
+15 KILL DIC
+16 ;I $D(^TMP("PSODAOC",$J,PSOKIND,SEV,ZVA,70,"CL")) S PSODAOCN=70 D CLINEFF S DA=ODA,DA(1)=ODA(1)
End DoDot:1
+17 ;Q
+18 ;
CLINEFF ;clinical effects
+1 NEW PSOFILE,PSOIENS,PSOCLEFF,DIWL,DIWR,DIWF,DINUM,DR,OLDX,OLD
+2 if '$DATA(^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,"CL"))
QUIT
+3 KILL DIC,^UTILITY($JOB,"W")
+4 SET DIWL=1
SET DIWR=78
SET DIWF=""
SET (DINUM,PSOCLEFF,OLDX)=""
+5 IF SEV="S"
SET X="*** Refer to MONOGRAPH for SIGNIFICANT INTERACTION CLINICAL EFFECTS"
DO ^DIWP
GOTO CLINEFF1
+6 FOR
SET PSOCLEFF=$ORDER(^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,"CL",PSOCLEFF))
if PSOCLEFF=""
QUIT
Begin DoDot:1
+7 SET X=""
SET X=^TMP("PSODAOC",$JOB,PSOKIND,SEV,ZVA,"CL",PSOCLEFF,0)
IF X'=OLDX
DO ^DIWP
End DoDot:1
SET OLDX=X
CLINEFF1 ;
+1 SET X=""
SET DIC="^ORD(100.05,"_DA(1)_",10,"
SET DIC(0)="Z"
+2 SET (DA,DINUM)=$ORDER(^ORD(100.05,DA(1),10,9999),-1)+1
+3 DO FILE^DICN
+4 KILL DIC,DIE,DR
+5 SET PSOFILE=100.05
SET PSOCLEFF=""
SET PSOCLEFF=$NAME(^UTILITY($JOB,"W",1))
+6 DO WP^DIE(PSOFILE,DA(1),100,"A",PSOCLEFF,"PSOER")
+7 KILL ^UTILITY($JOB,"W")
+8 ;
+9 ;for some strange reason if you put the following code before CLINEFF the clinical effects aren't stored.
+10 KILL DIC,DIE,DIR,DA
+11 SET DA=ODA
+12 IF $PIECE(ZORT,";")="R"
Begin DoDot:1
+13 SET DIE="^ORD(100.05,"_DA_",7,"
SET DA(2)=DA
SET DA(1)=7
SET DR="2///"_PSORSITI
+14 SET DA=99999
SET DA=$ORDER(^ORD(100.05,DA(2),7,DA),-1)
+15 DO ^DIE
End DoDot:1
+16 QUIT
+17 ;
LBL(RXN) ;
+1 ;Q "OP "_$S($G(ZZVER):"Verification ",$G(ZFRENEW):"CPRS RENEWAL ",$G(ZZEDIT):"EDIT ",$G(ZZCOPY):"COPY ",$G(PSOREINS):"REINSTATE ",$P(^PSRX(RXN,"STA"),"^")=1:"NON-VERIFIED ",$G(PSOARENW)=1:"RENEWAL ",1:"NEW ")_$G(PSOZH)
LBL2 ;
+1 NEW TEXT
+2 SET TEXT=""
SET TEXT="OP "_$SELECT('$DATA(^XUSEC("PSORPH",DUZ))&($PIECE(^PSRX(RXN,"STA"),"^")):"Non-Verified ",$DATA(^XUSEC("PSORPH",DUZ))&($GET(ZZVER)):"RPh Verification ",1:"")
+3 SET TEXT=TEXT_$SELECT($GET(ZFRENEW):"CPRS RENEWAL ",$GET(ZZEDIT):"EDIT ",$GET(ZZCOPY):"COPY ",$GET(PSOREINS):"REINSTATE ",$GET(PSOARENW)=1:"RENEWAL ",1:"NEW ")
+4 QUIT TEXT
