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

PSODDPR7.m

Go to the documentation of this file.
  1. PSODDPR7 ; BIR/OG ; Enhanced order checks - IMO Utilities ;Nov 17, 2021@14:00
  1. ;;7.0;OUTPATIENT PHARMACY;**390,411,663**;DEC 1997;Build 2
  1. ;External reference to IN^PSJBLDOC supported by DBIA 5306
  1. ;External reference to ^PS(50.606 supported by DBIA 2174
  1. ;External reference to ^PS(50.7 supported by DBIA 2223
  1. ;
  1. ; Required to be present:
  1. ; DFN: patient internal entry number
  1. ; DRG - dispensed drug name
  1. ; SV - Severity
  1. ; ZVA - VA Generic Name
  1. ; ON: Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5"
  1. ;
  1. Q:$E($P(ON,";"))'["C"
  1. N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON,PSOCLINI,SORT2,PSOCLIN
  1. N PSOCDRG,DRGDRG,STARTDTF,STOPDTF,ORDDATE,DNM,DUPRX0,PDRG,RXREC,RDIRX
  1. S SORT="PSOPEPS CLINIC"
  1. S (PSOCDRG,PSOCON,STATUS)=""
  1. Q:'$D(PSOCLNS(SV,ZVA))
  1. ;sort by status within drug name
  1. F S PSOCDRG=$O(PSOCLNS(SV,ZVA,PSOCDRG)) Q:PSOCDRG="" I DRG=PSOCDRG F S PSOCON=$O(PSOCLNS(SV,ZVA,PSOCDRG,PSOCON)) Q:PSOCON="" D
  1. .S (ORDID,PSOCLINI,FILENODE)="",DRGDRG=1,ORDID=$P(PSOCON,";",2),PSOCLINI=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",7),FILENODE=$P(PSOCLINI,";")
  1. .I FILENODE=1 D PSS436^PSS55(PSODFN,ORDID,SORT) S:$D(^TMP($J,SORT,ORDID,100)) STATUS=$P(^TMP($J,SORT,ORDID,100),"^",2)
  1. .I FILENODE=2 D PSS431^PSS55(PSODFN,ORDID,"","",SORT) S:$D(^TMP($J,SORT,ORDID,28)) STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
  1. .I FILENODE=3!(FILENODE=4)!(FILENODE=5) D PSJ^PSJ53P1(ORDID,SORT) S:$D(^TMP($J,SORT,ORDID,28)) STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
  1. .I STATUS="" S STATUS="Z"
  1. .S PSOCLIN(SV,ZVA,$S(STATUS["ACTIVE":1,STATUS["NON-VERIFIED":2,STATUS["DISCONTINUED":3,STATUS["EXPIRE":4,1:5),PSOCON)=PSOCDRG
  1. Q:'$D(PSOCLIN(SV,ZVA))
  1. S (SORT2,ORDID,PSOCLINI,FILENODE,PSOCON)=""
  1. K ^TMP($J,SORT)
  1. F S SORT2=$O(PSOCLIN(SV,ZVA,SORT2)) Q:SORT2="" F S PSOCON=$O(PSOCLIN(SV,ZVA,SORT2,PSOCON)) Q:PSOCON="" D CLINIC
  1. Q
  1. DUP ;
  1. ;Required: ZCT = Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5"
  1. Q:ZCT=""
  1. N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON
  1. N PSOCLINI,SORT2,PSOCLIN,DRGDRG,STARTDTF,STOPDTF,ORDDATE,DURATION
  1. S SORT="PSOPEPS CLINIC",DRGDRG=0
  1. S PSOCON=$P(ZCT,"^",3),DRGNAME=$P(ZCT,"^",2) D CLINIC
  1. Q
  1. ;
  1. CLINIC ;
  1. K ^TMP($J,SORT)
  1. S (ORDID,PSOCLINI,FILENODE)="",ORDID=$P(PSOCON,";",2),PSOCLINI=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",7)
  1. Q:'PSOCLINI
  1. S FILENODE=$P(PSOCLINI,";") I DRGDRG S DRGNAME=PSOCLIN(SV,ZVA,SORT2,PSOCON) I DRGNAME'="" S DRGDRG=0
  1. S (STATUS,SCHEDULE,DOSAGE,STARTDT,STOPDT,INFUSE,STARTDTF,STOPDTF,ORDDATE)=""
  1. D GETDATA
  1. K ^TMP($J,SORT)
  1. W !
  1. Q
  1. GETDATA ;
  1. I FILENODE=1 D PSS436^PSS55(PSODFN,ORDID,SORT) D Q ;IV for file 55
  1. .I DRGDRG S DRGNAME=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",4)
  1. .I $D(^TMP($J,SORT,ORDID,100)) S STATUS=$P(^TMP($J,SORT,ORDID,100),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,.09)) S SCHEDULE=^TMP($J,SORT,ORDID,.09)
  1. .I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,6,109)
  1. .I $D(^TMP($J,SORT,ORDID,.02)) S STARTDT=$P(^TMP($J,SORT,ORDID,.02),"^",2)
  1. .I STARTDT="" S:$D(^TMP($J,SORT,ORDID,115)) STARTDT=$D(^TMP($J,SORT,ORDID,115)) S:STARTDT'="" STARTDTF=1
  1. .I $D(^TMP($J,SORT,ORDID,.03)) S STOPDT=$P(^TMP($J,SORT,ORDID,.03),"^",2)
  1. .S:$D(^TMP($J,SORT,ORDID,27)) ORDDATE=^TMP($J,SORT,ORDID,27)
  1. .I STOPDT="" S:$D(^TMP($J,SORT,ORDID,117)) STARTDT=$D(^TMP($J,SORT,ORDID,117)) S:STOPDT'="" STOPDTF=1
  1. .I $D(^TMP($J,SORT,ORDID,.08)) S INFUSE=^TMP($J,SORT,ORDID,.08)
  1. .D WRITE
  1. ;
  1. I FILENODE=2 D PSS431^PSS55(PSODFN,ORDID,"","",SORT) D Q ;Unit dose for file 55
  1. .I DRGDRG S DRGNAME=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",4)
  1. .I $D(^TMP($J,SORT,ORDID,28)) S STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,26)) S SCHEDULE=^TMP($J,SORT,ORDID,26)
  1. .I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,ORDID,109)
  1. .I $D(^TMP($J,SORT,ORDID,10)) S STARTDT=$P(^TMP($J,SORT,ORDID,10),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,34)) S STOPDT=$P(^TMP($J,SORT,ORDID,34),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,.08)) S INFUSE=^TMP($J,SORT,ORDID,.08)
  1. .D WRITE
  1. ;
  1. I FILENODE=3!(FILENODE=4)!(FILENODE=5) D Q ;unit dose for file 53.1
  1. .D PSJ^PSJ53P1(ORDID,SORT)
  1. .I DRGDRG,$D(^TMP($J,SORT,ORDID,108)) S DRGNAME=$P(^TMP($J,SORT,ORDID,108),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,28)) S STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,26)) S SCHEDULE=$P(^TMP($J,SORT,ORDID,26),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,27)) S ORDDATE=^TMP($J,SORT,ORDID,27) S Y=ORDDATE D DD^%DT S ORDDATE=Y K Y
  1. .I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,ORDID,109)
  1. .I $D(^TMP($J,SORT,ORDID,10)) S STARTDT=$P(^TMP($J,SORT,ORDID,10),"^",2)
  1. .I STARTDT="",$D(^TMP($J,SORT,ORDID,115)) S STARTDT=$P(^TMP($J,SORT,ORDID,115),"^",2) S:STARTDT'="" STARTDTF=1
  1. .I $D(^TMP($J,SORT,ORDID,25)) S STOPDT=$P(^TMP($J,SORT,ORDID,25),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,117))&(STOPDT="") S STOPDT=$P(^TMP($J,SORT,ORDID,117),"^",2) S:STOPDT'="" STOPDTF=1
  1. .I $D(^TMP($J,SORT,ORDID,116)) S DURATION=^TMP($J,SORT,ORDID,116)
  1. .D WRITE
  1. Q
  1. ;
  1. WRITE ;
  1. D HD^PSODDPR2() Q:$G(PSODLQT)
  1. S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
  1. ;PSO*7.0*663 begin - check for pending clinic orders
  1. ; with free text dosages (i.e. no dispense drug).
  1. N PSODRUGX
  1. S PSODRUGX=DRGNAME
  1. I $G(ORDID),$P($G(^PS(53.1,+ORDID,0)),U,9)="P" D
  1. . I $O(^PS(53.1,+ORDID,1,0)) Q
  1. . ;no dispense drug, so display only name and dosage type (TAB, etc.)
  1. . N PSOIENX
  1. . S PSOIENX=$$GET1^DIQ(53.1,+ORDID,108,"I")
  1. . S PSODRUGX=$$GET1^DIQ(50.7,PSOIENX,.01)_" "_$$GET1^DIQ(50.7,PSOIENX,.02)
  1. W:'$G(PSODUPF) !,$J("Clinic Order: ",23)_PSODRUGX_" ("_STATUS_")"
  1. ;PSO*7.0*663 end
  1. I $D(^TMP($J,SORT,ORDID,"ADD")) D:FILENODE=1 IV55 D:FILENODE=3 IV531
  1. I SCHEDULE'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Schedule: ",23),SCHEDULE
  1. I DOSAGE'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Dosage: ",23),DOSAGE
  1. I STARTDT=""&(ORDDATE'="") S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Order Date: ",23),ORDDATE
  1. I STARTDT'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J($S($G(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT
  1. E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Start Date: ",23),"********"
  1. I STOPDT'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J($S($G(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT
  1. E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Stop Date: ",23),"********"
  1. WRITE2 ;
  1. I '$G(PSODUPF) D HD^PSODDPR2():(($Y+5)>IOSL)
  1. Q
  1. ;
  1. IMO(DFN) ;Inpatient Meds ordered in outpatient pharmacy (IMO) - determine IMO drugs to be added to the profile drugs submitted to FDB.
  1. ; In: DFN - Patient IED
  1. ; Output: ^TMP( file of inpatient meds drugs; example of each type of order:
  1. ; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C2;6;PROFILE;6")="16579^4010153^65^SIMVASTATIN 40MG TAB^10711^I"
  1. ; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C4;1597;PROFILE;7")="11664^4006819^1848^CIMETIDINE 300MG/5ML SOL (OZ)^10746^I"
  1. ;
  1. ; The first piece of the 5th subscript denotes the type of order (ex: C2 and C4 in the example above).
  1. ; When adding clinic orders, this piece is always "C" concatenated with an number 1-4 where 1 means UD file 55, 2 means IV file 55, 3 means UD file 53.1 or 4 means IV for file 53.1.
  1. ; For clinic orders, the 2nd piece of the 5th subscript is the subfile IEN.
  1. ;
  1. D IN^PSJBLDOC(DFN,LIST,.PDRG,"O;")
  1. Q
  1. ;
  1. IV55 ;
  1. I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
  1. S (ADD,SOL,AFLG)=0
  1. ;W:'$G(AFLG) !,$J("Other Additives: ",23)
  1. F S ADD=$O(^TMP($J,SORT,ORDID,"ADD",ADD)) Q:ADD="" D
  1. .I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.01)) S ADDNAM=$P(^TMP($J,SORT,ORDID,"ADD",ADD,.01),"^",2)
  1. .Q:DRGNAME[(ADDNAM_" "_^TMP($J,SORT,ORDID,"ADD",ADD,.02))
  1. .S (BOTTLE,STRENGTH)=""
  1. .I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.03)) S BOTTLE=^TMP($J,SORT,ORDID,"ADD",ADD,.03)
  1. .I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.02)) S STRENGTH=^TMP($J,SORT,ORDID,"ADD",ADD,.02)
  1. .I '$G(AFLG) S ADDS=ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
  1. .I $G(AFLG) S ADDS=ADDS_", "_ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
  1. .S:'$G(AFLG) AFLG=1
  1. S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
  1. I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
  1. I $G(AFLG),'$G(PSODUPF) W !,$J("Other Additives: ",23) D MYWRITE(ADDS,23,78)
  1. F S SOL=$O(^TMP($J,SORT,ORDID,"SOL",SOL)) Q:SOL="" D
  1. .S (SOLUTION,VOLUME)=""
  1. .I $D(^TMP($J,SORT,ORDID,"SOL",SOL,.01)) S SOLUTION=$P(^TMP($J,SORT,ORDID,"SOL",SOL,.01),"^",2)
  1. .I $D(^TMP($J,SORT,ORDID,"SOL",SOL,1)) S VOLUME=^TMP($J,SORT,ORDID,"SOL",SOL,1)
  1. .I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
  1. .W:'$G(SFLG)&'$G(PSODUPF) !,$J("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE
  1. .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
  1. .I $G(SFLG),'$G(PSODUPF) W !?23,SOLUTION_" "_VOLUME_" "_INFUSE
  1. .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
  1. .S SFLG=1
  1. Q
  1. ;
  1. IV531 ;
  1. I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
  1. S (ADD,SOL,AFLG,SFLG)=0
  1. F S ADD=$O(^TMP($J,SORT,ORDID,"ADD",ADD)) Q:ADD="" D
  1. .S (BOTTLE,STRENGTH,IVDATA)="",IVDATA=^TMP($J,SORT,ORDID,"ADD",ADD)
  1. .S BOTTLE=$P(IVDATA,"^",3),STRENGTH=$P(IVDATA,"^",2),ADDNAM=$P(IVDATA,"^")
  1. .I $D(^TMP($J,SORT,ORDID,"ADD",ADD+1)) Q:DRGNAME[(ADDNAM_" "_STRENGTH)
  1. .I '$G(AFLG) S ADDS=ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
  1. .I $G(AFLG) S ADDS=ADDS_", "_ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
  1. .S:'$G(AFLG) AFLG=1
  1. S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
  1. I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
  1. I $G(AFLG),'$G(PSODUPF) W !,$J("Other Additives: ",23) D MYWRITE(ADDS,23,78)
  1. F S SOL=$O(^TMP($J,SORT,ORDID,"SOL",SOL)) Q:SOL="" D
  1. .S (SOLUTION,VOLUME)=""
  1. .S (SOLUTION,VOLUME,IVDATA)="",IVDATA=^TMP($J,SORT,ORDID,"SOL",SOL)
  1. .S VOLUME=$P(IVDATA,"^",2),SOLUTION=$P(IVDATA,"^")
  1. .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
  1. .W:'$G(SFLG)&'$G(PSODUPF) !,$J("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE
  1. .I $G(SFLG),'$G(PSODUPF) W !?23,SOLUTION_" "_VOLUME_" "_INFUSE
  1. .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
  1. .S SFLG=1
  1. I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
  1. Q
  1. ;
  1. MYWRITE(X,DIWL,DIWR) ;Continue writing on the same line
  1. NEW DN,PSOCNT
  1. I '$G(DIWL) S DIWL=1
  1. I '$G(DIWR) S DIWR=75
  1. K ^UTILITY($J,"W") D ^DIWP
  1. F PSOCNT=0:0 S PSOCNT=$O(^UTILITY($J,"W",DIWL,PSOCNT)) Q:'PSOCNT W:PSOCNT'=1 ! W ?DIWL,^UTILITY($J,"W",DIWL,PSOCNT,0)
  1. Q
  1. NOCAN ;shows duplicate therapeutic when cancel duplicate class parameter is set to 'no'
  1. K ^UTILITY($J,"W"),DDTH,DOCPL,DIWF S DIWL=1,DIWR=78,DIWF=""
  1. N DUPCPF,PSODUPT,ZZOCTD,CLINTYP,CT,SUB,ZZOC S ZZOCTD=0
  1. S (CT,SUB,ZZOC)=0 K TCT,TCTP,TCTL,TCTI,ZZQ,ZHDR ;PSO*7*411
  1. F S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT F S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB D
  1. .S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2)
  1. .I $G(PSODCTH(ON)) Q
  1. .I $P(ON,";")="Z" Q
  1. .I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q
  1. .I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q
  1. .I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
  1. .I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
  1. .I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q
  1. .I '$G(ZHDR) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) W !,PSONULN,!,"*** THERAPEUTIC DUPLICATION(S) *** "_PSODRUG("NAME")_" with",! S ZHDR=1
  1. Q:'$G(ZHDR) Q:$G(PSODLQT)
  1. N ST,STA,STAT,ORT,CT K DOCPL
  1. S (SUB,CT)=0 F S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT F S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB D DUPCL K DDTH
  1. D DUPCP
  1. S:$D(ZPSODCTH) ^TMP("PSODAOC",$J,"DT","T","A",50,PSODRUG("IEN"),0)=""
  1. Q
  1. DUPCL ;
  1. S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2)
  1. I $P(ON,";")="Z" Q
  1. I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q
  1. I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q
  1. I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
  1. I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
  1. I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q
  1. S ORT=$S($P(ON,";")="N":4,$P(ON,";")="P":3,$P(ON,";")="R":2,1:1)
  1. S DOCPL(ORT,ON)=""
  1. Q
  1. ;
  1. DUPCP D HD^PSODDPR2():(($Y+5)'>IOSL) S ORT=0,ON="" F S ORT=$O(DOCPL(ORT)) Q:'ORT!$G(PSODLQT) F S ON=$O(DOCPL(ORT,ON)) Q:ON=""!$G(PSODLQT) D
  1. .S PSODUPT=""
  1. .I $P(ON,";")="O" S PSODUPT="O" D
  1. ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S ST=$P(^PSRX($P(ON,";",2),"STA"),"^")+1
  1. ..S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^^EXPIRED^DISCONTINUED^^DISCONTINUED BY PROVIDER^DISCONTINUE EDIT^PROVIDER HOLD"
  1. ..S STAT=$P(STA,"^",ST) W !?2,"Local Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" ("_STAT_") for "_$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^")
  1. .I $P(ON,";")="P" S PSODUPT="P" D
  1. ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
  1. ..S RXREC=$P(ON,";",2),DNM=$P(^PS(52.41,RXREC,0),"^",9)
  1. ..S DUPRX0=^PS(52.41,RXREC,0)
  1. ..W !?2,"Pending Order for "
  1. ..I '$P(DUPRX0,"^",9) W $P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
  1. ..E W $P(^PSDRUG($P(DUPRX0,"^",9),0),"^")
  1. .I $P(ON,";")="R" S PSODUPT="R" N RXDAT D
  1. ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
  1. ..S RXDAT=^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2))
  1. ..S RDIRX=$P(RXDAT,"^",5) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) W !?2,"Remote Rx #"_RDIRX_" ("_$P(RXDAT,"^",4)_") for "_$P(RXDAT,"^",3)
  1. .I $P(ON,";")="N" S PSODUPT="N" D
  1. ..Q:'$D(^PS(55,PSODFN,"NVA",$P(ON,";",2),0))
  1. ..S DUPRX0=^PS(55,PSODFN,"NVA",$P(ON,";",2),0) N NVAQ
  1. ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
  1. ..W !?2,"Non-VA Med for "
  1. ..I '$P(DUPRX0,"^",2) W $P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
  1. ..E W $P(^PSDRUG($P(DUPRX0,"^",2),0),"^")
  1. .I $P(ON,";")["C" S PSODUPT="C" D
  1. ..;CLINIC ORDERS ;1=55V,2=55U,3=531I,4=531U,5=531I
  1. ..N DRGNAME S DRGNAME=$P($G(^TMP($J,LIST,"IN","PROFILE",ON)),"^",4)
  1. ..S (PSOCON,ORDID,ZCT,CLINTYP)=ON,DRGDRG=0,DUPCPF=1,SORT="PSOPEPS CLINIC" D CLINIC
  1. ..S CLINTYP=$P(^TMP($J,"PSOPEPS","IN","PROFILE",ON),"^",7)
  1. ..S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)=$S($P(CLINTYP,";")[1:"V",$P(CLINTYP,";")[3!($P(CLINTYP,";")[4)!(($P(CLINTYP,";")[5)):$E($P(ON,";",1),2)_";PS(53.1",1:"U")_";"_$P(ON,";",2)
  1. ..S ^TMP("PSODAOC",$J,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
  1. ..;S ^TMP("PSODAOC",$J,"DT","T","A",70,"ADDITIVE",ZPSODCTH(ON),
  1. .S DDTH(ON)=1
  1. .I PSODUPT="R" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)="R;"_$P(ON,";",2) S ^TMP("PSODAOC",$J,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
  1. .I PSODUPT="N" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)="N;"_$P(ON,";",2) S ^TMP("PSODAOC",$J,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
  1. .I PSODUPT="P" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)=$P(ON,";",2)_";PS(52.41" S ^TMP("PSODAOC",$J,"DT","T","A",60,ZZOCTD,0)=ZPSODCTH(ON)
  1. .I PSODUPT="O" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)=$P(ON,";",2)_";PSRX(" S ^TMP("PSODAOC",$J,"DT","T","A",60,ZZOCTD,0)=ZPSODCTH(ON)
  1. .S:$D(ZPSODCTH) ^TMP("PSODAOC",$J,"DT","T","A",50,PSODRUG("IEN"),0)=""
  1. D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
  1. D CLASSES^PSODDPR3
  1. N X,ZZCT S (ZCT,ZZCT)=0
  1. 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
  1. .S X=^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")
  1. .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:"")
  1. .I $G(X)]"" S ^TMP("PSODAOC",$J,"DT","T","A","CL",ZZCT,0)=X
  1. D HD^PSODDPR2(0,1) Q:$G(PSODLQT)
  1. Q