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

PSODDPR2.m

Go to the documentation of this file.
PSODDPR2 ;BIR/SAB - display enhanced order checks ;11 May 2010  9:06 AM
 ;;7.0;OUTPATIENT PHARMACY;**251,375,379,390,372,416,411,458,402**;DEC 1997;Build 8
 ;External reference to ^PS(50.606 supported by DBIA 2174
 ;External reference to ^PS(50.7 supported by DBIA 2223
 ;External reference to ^PS(55 supported by DBIA 2228
 ;External reference to ^PSDRUG( supported by DBIA 221
 ;External reference to PSOL^PSSLOCK supported by DBIA 2789 
 K ^UTILITY($J),PSODRUG("BAD"),THER,THERO,^TMP($J,"PSODCOR"),PSOINTV,PSOVAG,PSODD,PSI,PSORDIT,DRGNM,PDODCNT
 I $O(^TMP($J,LIST,"OUT","EXCEPTIONS",""))]"" D EXC^PSODDPR5 G EXIT:$G(PSODLQT)
 N COUNT,DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PSONULN,PSONULN1,LST,LSI,DGI,SER,SERS,DUPT,SV,PSOLINES,OLDDRG,PSOOLDD,PSOTSUB,PSODSEQ,ZST,ZHDR,ZSUB,ZZDGDGC,PSOCLNS
 N PSOSEVER,PSODDSEQ,ZMED,COUNT2
 S (ON,DRG,SV,LSI,DGI,SER,SERS,PSOOLDD,PSOSEVER)="",(ZZDGDGC,CT,COUNT)=0,$P(PSONULN,"-",79)="-",$P(PSONULN1,"=",79)="=",ZHDR=1
 D NSRT^PSODDPR5 K ^TMP("PSODGI",$J),^TMP("PSOSER",$J),^TMP("PSOSERS",$J),^TMP("PSODGS",$J),^TMP("PSOTDD",$J,1)
 S (ON,DRG,SV,DGI,SER,SERS,ZVA)="",(ZST,ZORS,CT,COUNT)=0 N ZZOC S ZZOC=0,PSODDSEQ=0 ; PSO*7*411 
 F  S SV=$O(ZZDGDG(SV)) Q:SV=""!$G(PSODLQT)  F  S ZST=$O(ZZDGDG(SV,ZST)) Q:'ZST!$G(PSODLQT)  F  S ZORS=$O(ZZDGDG(SV,ZST,ZORS)) Q:'ZORS!$G(PSODLQT)  D
 .F  S ZVA=$O(ZZDGDG(SV,ZST,ZORS,ZVA)) Q:ZVA=""!$G(PSODLQT)  F  S DRG=$O(ZZDGDG(SV,ZST,ZORS,ZVA,DRG)) Q:DRG=""!$G(PSODLQT)  S COUNT=COUNT+1 D DUP^PSODDPR8,BLD2^PSODGDGP
 K HZVA,ZVA,ZORS,ZZDGDG,PSOCLNS,COUNT,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,CDDT D HD() G EXIT:$G(PSODLQT) ;PSO*7*411
 Q:$D(PSSDIUTL)
 I +$G(PSOINTV) D INT G EXIT:$G(PSODLQT)
 I $G(PSORX("DFLG")) W:$G(COPY) !,$C(7),"RX DELETED",! S PSORX("DFLG")=1,POERR("DFLG")=1,VALMBCK="R" G EXIT  Q
 I '$D(^XUSEC("PSORPH",DUZ)) K PSORX("INTERVENE")
 ;
 I $G(PSORX("INTERVENE"))]"" D
 .K PSODAL("DA") D FULL^VALM1,^PSORXI S:'$G(POERR) VALMBCK="R" W !
 ;
 I $G(PSORX("DFLG")) G EXIT
 I $O(^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",""))]"" D  G EXIT:PSODLQT  I ($Y+5)>IOSL W @IOF
 .S NODDERR=1 K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR
 .I ($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT Q
 .D HD() Q:$G(PSODLQT)  W !,"Drug Interaction Error(s):",! S CT=0,ON=""
 .F  S ON=$O(^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON)) Q:ON=""  F  S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON,CT)) Q:'CT  D
 ..Q:$G(NODDERR)&($P(ON,";")'="Z")
 ..W ?5,$S($P(ON,";")="N":"",$P(ON,";")="R":"Remote Rx for ",$P(ON,";")="O":"Local Rx for ",1:"Prospective Rx for ")
 ..W " "_^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON,CT,"MSG"),!,"   "_^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON,CT,"TEXT"),!
 ..D HD() Q:$G(PSODLQT)
 ;therapy
THER I '$O(^TMP($J,LIST,"OUT","THERAPY",0)) G EXIT
 I '$D(^XUSEC("PSORPH",DUZ)),$P(PSOPAR,"^",2),$G(PSOTECCK) G EXIT
 D NSRT1^PSODDPR5 K ZPSODCTH ;PSO*7*411
 N ON,DDTH,CLASS,QTHER,ZDRG,ZTHER K DUPT,THER,THERO,SUB,ZOT,ZCLASS,CDDT,ZPSODCTH I '$P(PSOPAR,"^",10) D NOCAN^PSODDPR7 G ERR ;PSO*7*411
 W @IOF,PSONULN1,! S (SUB,CT,LST,PSOZZ)=0 S (CDDT,THER)=1,THERO=0,QTHER=1 K RXDT ;PSO*7*411
 F  S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT!$G(PSODLQT)  F  S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB!$G(PSODLQT)  S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^") D
 .I $G(PSODCTH(ON)) Q
 .S RXREC=$P(ON,";",2)
 .I $P(ON,";")="Z" Q
 .I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q
 .I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q
 .I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
 .I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
 .I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q
 .S ZOT=$S($P(ON,";")["C":1,$P(ON,";")="O":2,$P(ON,";")="R":3,$P(ON,";")="P":4,1:5)
 .I $P(ON,";")="P" D  ;PSO*7*411
 ..I $G(ZPSODCTH($P(ON,";",2))) Q
 ..I '$P(^PS(52.41,$P(ON,";",2),0),"^",9) S ZDRG=$P(^PS(50.7,$P(^PS(52.41,$P(ON,";",2),0),"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
 ..E  S ZDRG=$P(^PSDRUG($P(^PS(52.41,$P(ON,";",2),0),"^",9),0),"^")
 ..S ZPSODCTH(ON)=$P(ON,";",2)_";PS(52.41"
 .I $P(ON,";")="O" D
 ..I $G(ZPSODCTH($P(ON,";",2))) Q  ;PSO*7*411
 ..S ZDRG=$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^")
 .I $P(ON,";")="N" D
 ..I $G(ZPSODCTH($P(ON,";",2))) Q  ;PSO*7*411
 ..S DUPRX0=^PS(55,PSODFN,"NVA",$P(ON,";",2),0)
 ..S ZPSODCTH(ON)="N;"_$P(ON,";",2)
 ..I '$P(DUPRX0,"^",2) S ZDRG=$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") Q
 ..S ZDRG=$P(^PSDRUG($P(DUPRX0,"^",2),0),"^")
 .I $P(ON,";")="R" D
 ..Q:'$D(^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2)))
 ..I $G(ZPSODCTH($P(ON,";",2))) Q  ;PSO*7*411
 ..S RXREC=^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2)),ZDRG=$P(RXREC,"^",3)
 ..S ZPSODCTH(ON)="R;"_$P(RXREC,"^",5)_";"_$P(RXREC,"^")_"^"_$P(RXREC,"^",3)_"^"_$P(RXREC,"^",2)
 .I $E($P(ON,";"))["C" D  ;PSO*7*411; PIECE 1 of ON can be C1 for IV file 55, C2 for UD file 55, C3 for IV file 53.1 or C4 for UD file 53.1
 ..S ZPSODCTH(ON)=1,RXREC=^TMP($J,LIST,"IN","PROFILE",ON),ZMED=$P(RXREC,U,3),ZDRG=$P(RXREC,U,4) Q:$D(ZTHER(ZOT_"^"_ZDRG_"^"_ON))  ; clinic order
 ..S ZPSODCTH(ON)=$S($P(ON,";")[1!$P(ON,";")[4:"V",1:"U")_";"_$P(ON,";",2)
 .S:$D(ZDRG) ZTHER(ZOT_"^"_ZDRG_"^"_ON,SUB)=ON K ZDRG
THER2 ;
 G EXIT:$G(PSODLQT)
 N PSOTHND1,PSOTHND2,PSOTHND3 S PSOTHND2=1,(PSOTHND1,PSOTHND3)=0
 I $O(ZTHER(""))]"" D
 .S (PSODUPF,PSODUPC,PSODUPC1,PSOTSUB)="" F  S PSODUPF=$O(ZTHER(PSODUPF)) Q:PSODUPF=""  F  S PSOTSUB=$O(ZTHER(PSODUPF,PSOTSUB)) Q:PSOTSUB=""  S PSODUPC1=PSODUPC1+1
 .;get line counts for each duplicate therapy by setting PSODUPF=1 and calling DUPCL to execute therapy code without actually displaying info. ; no breaks in the middle of displaying individual dup therapies.
 .S PSODUPF=1,PSODUPC=0,PSODUPC("CLASS")="" D DUPCL S PSODUPF=0
 .;set PSODUPF=0 then call DUPCL to actually print the duplicate therapies.
 .D DUPCL K DDTH,PSODUPC,PSODUPF,PSODUPC1,PSODUPC2
 G EXIT:$G(PSODLQT)
 K PSODCTH,RXDT,PSOZZ
 I $P(PSOPAR,"^",10),$O(^TMP($J,"PSODCOR",0)),'$G(PSODGCK) D DCOR^PSODDPR3 K ^TMP($J,"PSODCOR") S PSOTHND1=1 D HD() G EXIT:$G(PSODLQT) ;W !,PSONULN1,!
 E  D HD() ;I $D(^XUSEC("PSORPH",DUZ)) S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR W @IOF I '$G(PSODUPF),Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
 I 'PSOTHND1,'$G(PSODLQT),$D(^XUSEC("PSORPH",DUZ)) S PSOTHND3=1 D RTC
 I PSOTHND3>1,'$G(PSODLQT),$D(^XUSEC("PSORPH",DUZ)) D RTC
ERR I $O(^TMP($J,LIST,"OUT","THERAPY","ERROR",""))]"" D  S NODTERR=1 K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR
 .D HD() Q:$G(PSODLQT)  W !,"Drug Therapy Error(s):",! S CT=0,ON=""
 .F  S ON=$O(^TMP($J,LIST,"OUT","THERAPY","ERROR",ON)) Q:ON=""!$G(PSODLQT)  F  S CT=$O(^TMP($J,LIST,"OUT","THERAPY","ERROR",ON,CT)) Q:'CT!$G(PSODLQT)  D
 ..Q:$G(NODTERR)&($P(ON,";")'="Z")!$G(PSODLQT)
 ..D HD() Q:$G(PSODLQT)  W ?5,$S($P(ON,";")="P":"Pending Order: ",$P(ON,";")="N":"Non-VA Med Order: ",$P(ON,";")="R":"Remote Rx: ",$P(ON,";")="O":"Rx: ",1:"Prospective Rx: ")
 ..D HD() Q:$G(PSODLQT)  W " "_^TMP($J,LIST,"OUT","THERAPY","ERROR",ON,CT,"MSG"),!,"   "_^TMP($J,LIST,"OUT","THERAPY","ERROR",ON,CT,"TEXT"),!
 K ZON,ZPSOCTH,ZDDT
 I $O(^TMP($J,LIST,"OUT","THERAPY","ERROR",""))]"" S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT Q:$G(PSODLQT)
 D HD()
EXIT ;
 D ^PSOBUILD
 K DSPL,CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG,ZCT,ZZCT,ZZZCT,CDDT ;PSO*7*411
 K IT,LST,THER,THERO,^UTILITY($J),DGI,SER,SEV,SERS,BSIG,I,NODDERR,NODTERR,PDRG,DRGI,STATUS,^UTILITY($J,"W"),X,ZX,DIWL,DIWR,DIWF,THER,THERO,PSOINTV,ZTHER,PSOVORD,PSODCTH,ZZDGDG,ZZDGDG2,ZZHDR
 Q
 ;
RX D HD() Q:$G(PSODLQT)  W ! S RXREC=$P(ON,";",2)
 S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),STATUS=+$G(^PSRX(RXREC,"STA"))
 S RXRECLOC=$G(RXREC)
 S J=RXREC D STAT^PSOFUNC K RX0,RX2
 I $P($G(^PS(53,+$P($G(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS"!($G(PSORX("PATIENT STATUS"))["AUTH ABS")&'$P(PSOPAR,"^",5) W !,"PATIENT ON AUTHORIZED ABSENCE!" K RXRECLOC Q
 I STATUS>10,STATUS'=16 K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR W @IOF S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT,DIRUT,RXRECLOC Q
 I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)) S PSORX("DFLG")=1 K RXRECLOC Q
 I $P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)) S PSORX("DFLG")=1 K RXRECLOC Q
 I STATUS=16 W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! K DUP,RXRECLOC S PSORX("DFLG")=1 Q
 D PSOL^PSSLOCK(RXRECLOC) I '$G(PSOMSG) D  K PSOMSG,DIR,DUP,RXRECLOC S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR S PSORX("DFLG")=1 Q
 .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q
 .W !!,"Another person is editing Rx #"_$P($G(^PSRX(RXREC,0)),"^"),!
 K PSOMSG S DIR("A")=$S(STATUS=12:"Reinstate",1:"Discontinue")_" RX # "_$P(^PSRX(RXREC,0),"^"),DIR(0)="Y",DIR("?")="Enter Y to "_$S(STATUS=12:"reinstate",1:"discontinue")_" this RX."
 D ^DIR K DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT)
 S DA=RXREC S ACT=$S($D(SPCANC):"Reinstated during Rx cancel.",1:$S(STATUS=12:"Reinstated",1:"Discontinued")_" while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX")
 D CMOP^PSOUTL I $G(CMOP("S"))="L" W !,"A CMOP Rx cannot be discontinued during transmission!",! S Y=0 K CMOP
 I 'Y W $C(7)," -Prescription was not "_$S(STATUS=12:"reinstated",1:"discontinued")_"..." D  Q
 .S:'$D(PSOCLC) PSOCLC=DUZ S MSG=ACT,REA=$S(STATUS=12:"R",1:"C") S:$G(DUP) PSORX("DFLG")=1 K DUP
 .I $D(^TMP("PSORXDC",$J,RXREC,0)) K ^TMP("PSORXDC",$J,RXREC,0)
 S PSOCLC=DUZ,MSG=$S($G(MSG)]"":MSG,1:ACT_" During New RX "_$S('$G(PSONV):"Entry",1:"Verification")_" - Duplicate Rx"),REA=$S(STATUS=12:"R",1:"C")
 W !!,"THERAPEUTIC DUPLICATIONS will be discontinued after the acceptance of the new order.",!!
 S ^TMP("PSORXDC",$J,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_ST_"^"_DRG,PSONOOR="D"
 K RXRECLOC,DUP,CLS,PSONOOR,STATUS,ACT,PSONV,REA,SPCANC
 Q
 ;
DUPCL ;
 Q:$G(PSODLQT)
 S:$G(PSODUPF) PSODUPC=PSODUPC+1 ;W:'$G(PSODUPF) @IOF,PSONULN1,!
 I '$G(PSODUPF) W "*** THERAPEUTIC DUPLICATION(S) *** "_PSODRUG("NAME")_" with"
 S:$G(PSODUPF) PSODUPC=PSODUPC+1 N PSODUPCT,PSODUPC2,PSODUPCL
 S (PSODUPC2,PSODUPCT)=0 S:'$G(PSODUPF) PSODUPCT=2
 ;displays order and therapy
 K DDTH S (PSODUPCL,ZSUB,ZCT,PSODSEQ)=""
 F  S ZCT=$O(ZTHER(ZCT)) Q:ZCT=""!($G(PSODLQT))  F  S PSODSEQ=$O(ZTHER(ZCT,PSODSEQ)) Q:PSODSEQ=""!($G(PSODLQT))  S ON=ZTHER(ZCT,PSODSEQ) D
 .I '$G(PSODUPF) S PSOTHND3=PSOTHND3+1 I 'PSOTHND1,'$G(PSODLQT),$O(ZTHER(ZCT,PSODSEQ)),PSOTHND3>1 D RTC
 .S (PDODCNT,PSOTHND1)=0,PSODUPC2=PSODUPC2+1 I $G(PSODUPF) S PSODUPC(ZCT)=0
 .I PSODUPC2=PSODUPC2+1
 .I '$G(PSODUPF) D
 ..I PSODUPC2=PSODUPC1,(PSODUPCT+PSODUPC(ZCT)+PSODUPC("CLASS"))>22 D HD(15) Q:$G(PSODLQT)  S PSODUPCT=0
 ..I (PSODUPCT+PSODUPC(ZCT))>22 D HD(15) Q:$G(PSODLQT)  S PSODUPCT=0
 ..S PSODUPCT=PSODUPCT+PSODUPC(ZCT)
 .I $P(ON,";")="O" D HD() Q:$G(PSODLQT)  S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! S THER=1 D DDRX^PSODDPR8 D
 ..Q:STATUS>5&(STATUS'=16)
 ..Q:$G(^TMP("PSORXDC",$J,RXREC,0))]""
 ..Q:$G(RXDT("O",RXREC))
 ..S RX0=^PSRX(RXREC,0),J=RXREC,RX2=^PSRX(RXREC,2) D STAT^PSOFUNC K RX0,RX2
 ..S PSOZZ=PSOZZ+1,^TMP($J,"PSODCOR",PSOZZ)="52"_"^"_RXREC_"^"_ST_"^"_DRGNM,RXDT("O",RXREC)=1
 .I $P(ON,";")="N" D HD() Q:$G(PSODLQT)  S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! D ^PSODDPR3
 .I $P(ON,";")="P" D
 ..; PSO*7*411
 ..D HD(8) Q:$G(PSODLQT)  S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! S RXREC=$P(ON,";",2),THER=1 D PEND^PSODDPR8
 ..Q:$G(^TMP("PSORXDC",$J,RXREC,0))]""
 ..Q:$G(RXDT("P",RXREC))
 ..S PSOZZ=PSOZZ+1,DUPRX0=^PS(52.41,RXREC,0)
 ..S ^TMP($J,"PSODCOR",PSOZZ)="P"_"^"_RXREC_"^^"_$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^",2),0),"^"))
 ..S ^TMP($J,"PSODCOR",PSOZZ)=^TMP($J,"PSODCOR",PSOZZ)_"^"_$S('$P(DUPRX0,"^",9):$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"))
 ..S RXDT("P",RXREC)=1
 .I $P(ON,";")="R" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! D RDI^PSODDPR3 D HD() Q:$G(PSODLQT)
 .I $E($P(ON,";"))="C" D HD() Q:$G(PSODLQT)  S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! D DUP^PSODDPR7  ; clinic order
 .I $O(ZTHER(ZCT,PSODSEQ))'="" D HD() Q:$G(PSODLQT)  S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,PSONULN
 D CLASSES^PSODDPR3
 ;format therapy classes pso*7*411
 N X S (ZCT,ZZCT,ZZZCT)=0
 F  S ZZCT=$O(^TMP($J,LIST,"OUT","THERAPY",ZZCT)) Q:'ZZCT  S ZCT=0 F  S ZCT=$O(^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT)) Q:'ZCT  D
 .;S X=^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")  ; ME2 - 1602256
 .S X=^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")_$S($O(^TMP($J,LIST,"OUT","THERAPY",ZZCT))!($O(^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT))):", ",1:"")
 Q:$G(PSODLQT)!($D(^XUSEC("PSORPH",DUZ)))
 I '$G(PSODUPF),'$D(^XUSEC("PSORPH",DUZ)) D
 .S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR W @IOF
 .I '$G(PSODUPF),Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
 .I '$G(PSODUPF),($Y+5)>IOSL W @IOF
 Q
INT ;
 Q:$D(PSSDIUTL)
 D INT^PSODDPR5
 Q
HD(PSOLINES,OVRRID) ;
 S:'$G(PSODLQT) PSODLQT=0  S:'$G(OVRRID) OVRRID=0 S:'$G(PSOLINES) PSOLINES=5
 I '$G(OVRRID),$G(PSODLQT)!(($Y+PSOLINES)'>IOSL) Q
 I $G(PSOTHND2) S PSOTHND1=1
 N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR
 K PSOLINES,OVRRID
 I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
 W:'$G(PSODUPF) @IOF
 Q
 ;
DGSORT ;
 ;this sort is used in monograph and clinic effects display so that they are displayed once per VA generic drug
 S (SEV,TYP,PSOVAG,PSONAM)="" F  S SEV=$O(ZZDGDG3(SEV)) Q:SEV=""  F  S PSOVAG=$O(ZZDGDG3(SEV,PSOVAG)) Q:PSOVAG=""  D
 .S COUNT2=0 F  S PSONAM=$O(ZZDGDG3(SEV,PSOVAG,PSONAM)) Q:PSONAM=""  S COUNT2=COUNT2+1,ZZDGDG2(SEV,PSOVAG)=COUNT2
 K COUNT2,PSONAM
 Q
 ;
 ;
RTC ;Return to continue
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT S DIR(0)="EA",DIR("A")="Press Return to Continue: " D ^DIR K DIR W @IOF
 Q