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

PSOERUT.m

Go to the documentation of this file.
  1. PSOERUT ;ALB/MFR - eRx Utilities; 06/25/2022 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**692,700,746,769**;DEC 1997;Build 26
  1. ;
  1. DSPERX(ERXIEN) ; Displays eRx Info to the Screen
  1. ; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE (#52.49)
  1. ;
  1. I '$D(^PS(52.49,+$G(ERXIEN),0)) Q
  1. N HIGH,NORM,XX,ERXSIG,NOTES,MEDIEN,QTYQUAL
  1. S HIGH=$G(IOINHI),NORM=$G(IOINORM)
  1. S $P(XX,$S($D(IOUON):" ",1:"-"),81)="",$E(XX,34,45)="ORIGINAL ERX" W !,$G(IOUON),XX,$G(IOUOFF)
  1. W !,"eRx Drug : ",HIGH,$$GET1^DIQ(52.49,ERXIEN,3.1),NORM
  1. W !,"eRx SIG :" S ERXSIG=$$ERXSIG^PSOERXUT(ERXIEN)
  1. F I=1:1 Q:ERXSIG="" W ?11,HIGH,$E(ERXSIG,1,69),NORM,! S ERXSIG=$E(ERXSIG,70,9999)
  1. S NOTES=$$GET1^DIQ(52.49,ERXIEN,8)
  1. I NOTES'="" W "eRx Notes:" F I=1:1 Q:NOTES="" W ?11,HIGH,$E(NOTES,1,68),NORM,! S NOTES=$E(NOTES,71,9999)
  1. W "Drug Form: ",HIGH,$E($$GET1^DIQ(52.49,ERXIEN,41),1,44),NORM,?55,"Strength: ",HIGH,$E($$GET1^DIQ(52.49,ERXIEN,43),1,25),NORM
  1. S MEDIEN=$O(^PS(52.49,ERXIEN,311,0)),QTYQUAL=$$GET1^DIQ(52.49311,MEDIEN_","_ERXIEN_",",2.2,"I"),QTYQUAL=$$GET1^DIQ(52.45,+QTYQUAL,.02,"E")
  1. W !,"Qty Qualifier: ",HIGH,QTYQUAL,NORM,?40,"Qty Unit of Measure: ",HIGH,$$GET1^DIQ(52.49,ERXIEN,42),NORM
  1. W !,"Qty: ",HIGH,$$GET1^DIQ(52.49,ERXIEN,5.1),NORM
  1. W ?13,"Days Supply: ",HIGH,$$GET1^DIQ(52.49,ERXIEN,5.5),NORM
  1. W ?34,"Refills: ",HIGH,$$GET1^DIQ(52.49,ERXIEN,5.6),NORM
  1. W ?51,"Substitutions: ",HIGH,$S($$GET1^DIQ(52.49,ERXIEN,5.8,"I"):"NO",1:"YES"),NORM
  1. S XX="",$P(XX,$S($D(IOUON):" ",1:"-"),81)="" W !,$G(IOUON),XX,$G(IOUOFF)
  1. Q
  1. ;
  1. XML2GBL(XML,OUTARR) ;Transfers XML incoming data into a TMP Gobal
  1. ; Input: XML - XML Message to be transferred to a Temp Global or Local Array
  1. ; OUTARR - Output Array (Temp Global or Local Array, e.g. $NA(^TMP($J,"PSOERUT")), "XMLMSG", "MSG(""ERX"")", etc.
  1. ;Output: Parsed XML data in the Temp Global or Local Array
  1. ;
  1. ; Protecting from saving non-TEMP globals
  1. I $G(OUTARR)["^",$E(OUTARR,1,5)'="^TMP(",$E(OUTARR,1,6)'="^XTMP(" Q
  1. ;
  1. K @OUTARR
  1. N STATUS,READER,ARRDPTH,PRVDPTH,SEQ
  1. S PRVDPTH=0,ARRDPTH=$S(OUTARR[",":$L(OUTARR,","),OUTARR[")":1,1:0)
  1. S STATUS=##class(%XML.TextReader).ParseStream(XML,.READER)
  1. I $$STATCHK^XOBWLIB(STATUS,.XOBERR,1) D
  1. . F Q:'READER.Read()!READER.EOF D
  1. . . I (READER.Depth'<PRVDPTH),READER.LocalName'="" D
  1. . . . S SEQ=+$O(@$NA(@OUTARR@(READER.LocalName,999999)),-1)+1
  1. . . . S OUTARR=$NA(@OUTARR@(READER.LocalName,SEQ))
  1. . . E S:READER.Depth<PRVDPTH OUTARR=$NA(@OUTARR,ARRDPTH+(READER.Depth*2))
  1. . . I (READER.Value'="") D
  1. . . . S @(OUTARR)=READER.Value
  1. . . S PRVDPTH=READER.Depth
  1. Q
  1. ;
  1. PATNAME(ERXIEN) ; Returns the eRx Patient Name for a specific eRx Record
  1. ; Input: ERXIEN - eRx IEN - Pointer to #52.49
  1. ;Output: PATNAME - eRx Patient Name
  1. N PATIEN,MTYPE,PATNAME,NEWERX
  1. S PATIEN=+$$GET1^DIQ(52.49,ERXIEN,.04)
  1. S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
  1. S PATNAME=$$GET1^DIQ(52.46,PATIEN,.01,"E") I MTYPE="IE"!(MTYPE="OE") S PATNAME=$$GET1^DIQ(52.49,ERXIEN,.08,"E")
  1. I PATNAME="" D
  1. . S NEWERX=$$RESOLV^PSOERXU2(ERXIEN)
  1. . I NEWERX S PATNAME=$$GET1^DIQ(52.49,ERXIEN,.04,"E")
  1. . I PATNAME="" S PATNAME="N/A"
  1. Q PATNAME
  1. ;
  1. EPATFLST(MAXSIZE) ; Returns the eRx Patient Filter as a String List
  1. ;Input: MAXSIZE - Maximum Size for the String
  1. N PAT,PATFLST,TMP,PATNAM
  1. I '$D(PATFLTR) Q ""
  1. S PATFLST=""
  1. S PAT=0 F S PAT=$O(PATFLTR(PAT)) Q:'PAT D
  1. . S PATNAM=$$GET1^DIQ(52.46,PAT,.01) I PATNAM="" Q
  1. . S:'$D(TMP(PATNAM)) PATFLST=PATFLST_"|"_PATNAM
  1. . S TMP(PATNAM)=""
  1. S $E(PATFLST,1)=""
  1. I $L(PATFLST)>MAXSIZE S PATFLST=$E(PATFLST,1,MAXSIZE-3)_"..."
  1. Q PATFLST
  1. ;
  1. VPATFLST(MAXSIZE) ; Returns the VistA Patient Filter as a String List
  1. ;Input: MAXSIZE - Maximum Size for the String
  1. N VPAT,VPATFLST,TMP,PATNAM
  1. I '$D(VPATFLTR) Q ""
  1. S VPATFLST=""
  1. S VPAT=0 F S VPAT=$O(VPATFLTR(VPAT)) Q:'VPAT D
  1. . S PATNAM=$$GET1^DIQ(2,VPAT,.01) I PATNAM="" Q
  1. . S:'$D(TMP(PATNAM)) VPATFLST=VPATFLST_"|"_PATNAM
  1. . S TMP(PATNAM)=""
  1. S $E(VPATFLST,1)=""
  1. I $L(VPATFLST)>MAXSIZE S VPATFLST=$E(VPATFLST,1,MAXSIZE-3)_"..."
  1. Q VPATFLST
  1. ;
  1. VPRVFLST(MAXSIZE) ; Returns the VistA Provider Filter as a String List
  1. ;Input: MAXSIZE - Maximum Size for the String
  1. N VPRV,VPRVFLST,TMP,PRVNAM
  1. I '$D(VPRVFLTR) Q ""
  1. S VPRVFLST=""
  1. S VPRV=0 F S VPRV=$O(VPRVFLTR(VPRV)) Q:'VPRV D
  1. . S PRVNAM=$$GET1^DIQ(200,VPRV,.01) I PRVNAM="" Q
  1. . S:'$D(TMP(PRVNAM)) VPRVFLST=VPRVFLST_"|"_PRVNAM
  1. . S TMP(PRVNAM)=""
  1. S $E(VPRVFLST,1)=""
  1. I $L(VPRVFLST)>MAXSIZE S VPRVFLST=$E(VPRVFLST,1,MAXSIZE-3)_"..."
  1. Q VPRVFLST
  1. ;
  1. EPRVFLST(MAXSIZE) ; Returns the eRx Provider Filter as a String List
  1. ;Input: MAXSIZE - Maximum Size for the String
  1. N PRV,PRVFLST,TMP,PRVNAM
  1. I '$D(PRVFLTR) Q ""
  1. S PRVFLST=""
  1. S PRV=0 F S PRV=$O(PRVFLTR(PRV)) Q:'PRV D
  1. . S PRVNAM=$$GET1^DIQ(52.48,PRV,.01) I PRVNAM="" Q
  1. . S:'$D(TMP(PRVNAM)) PRVFLST=PRVFLST_"|"_$$GET1^DIQ(52.48,PRV,.01)
  1. . S TMP(PRVNAM)=""
  1. S $E(PRVFLST,1)=""
  1. I $L(PRVFLST)>MAXSIZE S PRVFLST=$E(PRVFLST,1,MAXSIZE-3)_"..."
  1. Q PRVFLST
  1. ;
  1. STATEABB(FILE,IEN) ; Returns the Patient or Provider State Abbreviation (eRx and VistA)
  1. ; Input: FILE - VistA File # (Can be 2, 200, 52.46 or 52.48)
  1. ; IEN - Internal Entry #
  1. ;Output: Abbreviated State (e.g., "TX", "AZ", "NY", etc...)
  1. N STATEIEN,FIELD
  1. S FIELD=$S(FILE=2:.115,FILE=52.46:3.4,FILE=200:.115,FILE=52.48:4.4,1:0) I 'FIELD!'$G(IEN) Q ""
  1. S STATEIEN=$$GET1^DIQ(FILE,IEN,FIELD,"I") I 'STATEIEN Q ""
  1. Q $$GET1^DIQ(5,STATEIEN,1)
  1. ;
  1. LASTREDT(XREF,IEN) ; Returns the Last eRx Received Date for a VistA Patient OR Provider
  1. ;Input: XREF - "AVPAT": VistA Patient | "AVPRV": VistA Provider
  1. ; IEN - Pointer to either VistA Patient (#2) or VistA Provider (#200)
  1. N LASTREDT,EIEN
  1. S LASTREDT=""
  1. S EIEN=0 F S EIEN=$O(^PS(52.49,XREF,+$G(IEN),EIEN)) Q:'EIEN D
  1. . I $O(^PS(52.49,XREF,+$G(IEN),EIEN,9999999),-1)>LASTREDT D
  1. . . S LASTREDT=$O(^PS(52.49,XREF,+$G(IEN),EIEN,9999999),-1)\1
  1. Q LASTREDT
  1. ;
  1. SSN(SSN) ; Returns the formatted SSN (999-99-9999)
  1. ; Input: SSN - Unformatted SSN (999999999)
  1. ;Output: Formatted SSN (999-99-9999)
  1. S SSN=$$NUMERIC^PSOASAP0(SSN)
  1. I $G(SSN)=""!(SSN'?.N)!($L(SSN)'=9) Q ""
  1. Q $E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
  1. ;
  1. ACTIONSTS(STS) ; Returns whether the eRx status is Actionable or no
  1. ; Input: STS - eRx Status. It can be external (e.g.,"N","RXF","RRN", etc...) or internal value (pointer to #52.45)
  1. ;Output: 1 - Actionable Status | 0 - Non-actionable status
  1. ;
  1. I $G(STS) S STS=$$GET1^DIQ(52.45,STS,.01)
  1. I $G(STS)="" Q 0
  1. I ",N,H,I,W,CAH,CAO,CAP,CAR,CAX,CAF,RXN,RXD,RXR,RXI,RXW,RXF,RXE,RRE,CXN,CXI,CXD,CXW,CXV,CXY,CXE,CRE,"[(","_STS_",") Q 1
  1. Q 0
  1. ;
  1. C2S(STR) ; Replaces commas with spaces (for auto-wrap to work) - Arbitrarily using '@' (not likely to be on the string)
  1. N C2S
  1. S C2S=$TR(STR," ","@")
  1. S C2S=$TR(C2S,","," ")
  1. Q C2S
  1. ;
  1. S2C(STR) ; Replaces spaces with commas (for auto-wrap to work)
  1. N S2C
  1. S S2C=$TR(STR," ",",")
  1. S S2C=$TR(S2C,"@"," ")
  1. I $E(S2C,$L(S2C))="," S $E(S2C,$L(S2C))=""
  1. Q S2C
  1. ;
  1. SORT(STR) ; Sorts a comma (,) separated list alphabetically
  1. N I,SARR,SSTR,WORD
  1. F I=1:1:$L(STR,",") I $TR($P(STR,",",I)," ")'="" S SARR($P(STR,",",I))=""
  1. S (SSTR,WORD)="" F S WORD=$O(SARR(WORD)) Q:WORD="" S SSTR=SSTR_","_WORD
  1. S $E(SSTR)=""
  1. Q SSTR
  1. ;
  1. WRAP(STRING,LENGTH,WRPSTR) ; Formats a String into an Array
  1. ; Input: STRING - String to be formatted/wrapped in multiple lines
  1. ; LENGHT - Text line length
  1. ;Output: .WRPSTR - String wrapped (Passed in by Reference)
  1. ;
  1. N X,I,DIWL,DIWR,DIWF,TOOLONG K WRPSTR
  1. S X=STRING K ^UTILITY($J,"W") S DIWL=1,DIWR=LENGTH,DIWF="|" D ^DIWP
  1. S TOOLONG=0 F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) I $L($$TRIM^XLFSTR(^UTILITY($J,"W",1,I,0)))>LENGTH S TOOLONG=1 Q
  1. I 'TOOLONG D
  1. . F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) S WRPSTR(I,0)=$$TRIM^XLFSTR(^UTILITY($J,"W",1,I,0))
  1. E D
  1. . S STRING=$$TRIM^XLFSTR(STRING)
  1. . F I=1:1 Q:STRING="" D
  1. . . S WRPSTR(I,0)=$E(STRING,1,LENGTH),STRING=$E(STRING,LENGTH+1,9999)
  1. I $G(WRPSTR(1,0))=" ",'$O(WRPSTR(1)) K WRPSTR
  1. Q
  1. ;
  1. SADRGVRX(ERXIEN,RXIEN) ; Sets the "ADRGVRX" cross-reference on the ERX HOLDING QUEUE file (#52.49),
  1. ; PHARMACY PRESCRIPTION NUMBER field (#.13)
  1. ; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
  1. ; RXIEN - Pointer to the PRESCRIPTION file (#52)
  1. I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^PSRX(+$G(RXIEN),0)) Q
  1. N PSOHASH
  1. I $$GET1^DIQ(52.49,ERXIEN,1)'="PR" Q
  1. S PSOHASH=$$DRUGHASH(ERXIEN) I 'PSOHASH Q
  1. S ^PS(52.49,"ADRGVRX",PSOHASH,RXIEN,ERXIEN)=""
  1. Q
  1. ;
  1. KADRGVRX(ERXIEN,RXIEN) ; Kills the "ADRGVRX" cross-reference on the ERX HOLDING QUEUE file (#52.49),
  1. ; PHARMACY PRESCRIPTION NUMBER field (#.13)
  1. ; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
  1. ; RXIEN - Pointer to the PRESCRIPTION file (#52)
  1. I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^PSRX(+$G(RXIEN),0)) Q
  1. N PSOHASH
  1. S PSOHASH=$$DRUGHASH^PSOERUT(ERXIEN) I 'PSOHASH Q
  1. K ^PS(52.49,"ADRGVRX",PSOHASH,RXIEN,ERXIEN)
  1. Q
  1. ;
  1. DRUGHASH(ERXIEN,FACTOR) ; Return the Drug Information corresponding Hash Value (Recursivity used)
  1. ; Input: ERXIEN - Pointer to the eRx being worked on (Pointer to #52.49)
  1. ; FACTOR - Counter used to prevent wrong matches
  1. ;Output: DRUGHASH - Hash value calculated based on the Drug information for the eRx passed in
  1. ;
  1. ;NOTICE: Any change that alters the hash value will require the ADRGVRX cross-reference to be rebuild
  1. ;
  1. N DRUGHASH,DRUGSIGH,MTYPE,RSPTYPE,DRUG,NDCCODE,DRUGSIG,QTY,SUBS,DAYS,REFS,X,I
  1. S DRUGHASH=0 I '$G(ERXIEN) Q 0
  1. S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
  1. S RSPTYPE=$$GET1^DIQ(52.49,ERXIEN,52.1,"I")
  1. S DRUG=$$GETDRUG^PSOERXU5(ERXIEN) I DRUG="" Q 0
  1. S NDCCODE=$TR($TR($$GET1^DIQ(52.49,ERXIEN,4.1)," "),"-")
  1. I NDCCODE="" S NDCCODE=$TR($TR($$GET1^DIQ(52.49311,"1,"_ERXIEN_",",1.1,"I")," "),"-")
  1. I NDCCODE="" Q 0
  1. S QTY=+$$GET1^DIQ(52.49,ERXIEN,5.1) I 'QTY Q 0
  1. S SUBS=+$$GET1^DIQ(52.49,ERXIEN,5.8,"I")
  1. S DAYS=+$$GET1^DIQ(52.49,ERXIEN,5.5,"I")
  1. S REFS=+$$GET1^DIQ(52.49,ERXIEN,5.6,"I") I MTYPE="RE",RSPTYPE="R",REFS>0 S REFS=$G(REFS)-1
  1. ; Concatenating Drug Name+SIG for Hash Calculation
  1. S DRUGSIGH=0,DRUGSIG=$E(DRUG_$$UANSIG(ERXIEN),1,200) I DRUGSIG="" Q 0
  1. F I=1:1:$L(DRUGSIG) S DRUGSIGH=($A(DRUGSIG,I)*(5**(I-1)))+DRUGSIGH
  1. S DRUGSIGH=DRUGSIGH#1000009+$G(FACTOR)
  1. ; NDC Code|Drug Name+SIG Hash|Substitution|Qty|Days Supply|# of Refills
  1. S DRUGHASH=NDCCODE_DRUGSIGH_SUBS_$E(1000+QTY,2,4)_$E(1000+DAYS,2,4)_$E(100+REFS,2,3)
  1. ; Checks if the SIG matches other eRx Sig's, if not increment FACTOR and try again (Recursive call)
  1. I '$$SAMESIG(ERXIEN,DRUGHASH) D
  1. . S DRUGHASH=$$DRUGHASH(ERXIEN,$G(FACTOR)+1)
  1. ;
  1. Q DRUGHASH
  1. ;
  1. SAMESIG(ERXIEN,HASH) ; Check if SIG matches other eRx with same Hash code
  1. ; Input: ERXIEN - Pointer to the eRx being worked on (Pointer to #52.49)
  1. ; DRUGHASH - Hash value calculated based on the Drug information for the eRx passed in
  1. ;Output: 1: SIG matches previous eRx Sigs (or no previous eRx with same Hash) | 0: SIG is different
  1. N SAMESIG,RX,ERX
  1. S SAMESIG=1 I '$G(ERXIEN)!'$G(HASH) Q 1
  1. S RX=$O(^PS(52.49,"ADRGVRX",HASH,0)) I RX D
  1. . S ERX=$O(^PS(52.49,"ADRGVRX",HASH,RX,0)) I ERX,ERX'=ERXIEN D
  1. . . I $$UANSIG(ERX)'=$$UANSIG(ERXIEN) S SAMESIG=0
  1. Q SAMESIG
  1. ;
  1. UANSIG(ERXIEN) ; Returns the SIG in upper case with alphanumeric chars only
  1. ; Input: ERXIEN - Pointer to the eRx being worked on (Pointer to #52.49)
  1. ;Output: UANSIG - eRx SIG in upper case and alphanumeric chars (e.g.: TAKE1TABLETPOONCEADAY)
  1. N UANSIG,X,I
  1. S UANSIG="",X=$$UP^XLFSTR($$ERXSIG^PSOERXUT(ERXIEN))
  1. F I=1:1:$L(X) I $E(X,I)?.AN S UANSIG=UANSIG_$E(X,I)
  1. Q UANSIG
  1. ;
  1. SUGFLDT(ORDIEN) ; Returns the Suggested Fill Date for the eRx Pending Order
  1. ; Input: ORDIEN - Ponter to the Pending Order (Pointer to #52.41)
  1. ;Output: SUGFLDT - p1: Suggested Fill Date for the Pending Order (YYYMMDD)
  1. ; p2: If p1>TODAY, return the pointer to the Rx from last fill (pointer to #52)
  1. N SUGFLDT,ERXIEN,NUMREFS,DAYSSUP,ISSUEDT,DONE,DFN,DRUG,RXIEN,DFN,SEQ,RXSTS,FILLDATE,RELDATE,LASTFILL
  1. I '$D(^PS(52.41,+$G(ORDIEN),0)) Q DT
  1. S SUGFLDT=DT,ERXIEN=$$ERXIEN^PSOERXUT(ORDIEN_"P")
  1. S DFN=$$GET1^DIQ(52.41,ORDIEN,1,"I"),DRUG=$$GET1^DIQ(52.41,ORDIEN,11,"I")
  1. S (DONE)=0,SEQ=99999 F S SEQ=$O(^PS(55,DFN,"P",SEQ),-1) Q:'SEQ D I DONE Q
  1. . S RXIEN=+$G(^PS(55,DFN,"P",SEQ,0)) I 'RXIEN Q
  1. . S RXSTS=+$$GET1^DIQ(52,RXIEN,100,"I") I ",0,3,5,11,12,14,15,"'[(","_RXSTS_",") Q
  1. . I $$GET1^DIQ(52,RXIEN,6,"I")'=DRUG Q
  1. . S DONE=1
  1. . I '$$SAMEDOSE^PSOERUT7(ERXIEN,RXIEN) Q
  1. . S LASTFILL=$$LSTRFL^PSOBPSU1(RXIEN)
  1. . S RELDATE=$$RXRLDT^PSOBPSUT(RXIEN,LASTFILL)\1
  1. . S FILLDATE=$$RXFLDT^PSOBPSUT(RXIEN,LASTFILL)
  1. . ; Last Fill is not released, is Suspended, Not Transmitted/Printed, Future Fill Date
  1. . I 'RELDATE,(RXSTS=5),FILLDATE>DT D S DONE=1 Q
  1. . . S SUGFLDT=FILLDATE_"^"_RXIEN
  1. . ; Last Fill is released and Last Fill + Days Supply is in the future
  1. . I RELDATE,$$FMADD^XLFDT(RELDATE,$$GET1^DIQ(52,RXIEN,8))>DT D S DONE=1 Q
  1. . . S SUGFLDT=$$FMADD^XLFDT(RELDATE,$$GET1^DIQ(52,RXIEN,8))_"^"_RXIEN
  1. . ; Last Fill is not released but fill is transmitted to CMOP
  1. . I 'RELDATE,$$CMOPSTS(RXIEN,LASTFILL)=0!($$CMOPSTS(RXIEN,LASTFILL)=2) D S DONE=1 Q
  1. . . S SUGFLDT=$$FMADD^XLFDT(DT,$$GET1^DIQ(52,RXIEN,8))_"^"_RXIEN
  1. . S SUGFLDT=DT_"^"_RXIEN
  1. ; If Pending order has no refills and Suggested Fill Date is after Issue Date+Days Supply, suggest TODAY
  1. S NUMREFS=$$GET1^DIQ(52.41,ORDIEN,13,"I"),DAYSSUP=$$GET1^DIQ(52.41,ORDIEN,101,"I")
  1. S ISSUEDT=$$GET1^DIQ(52.41,ORDIEN,6,"I") I 'ISSUEDT S ISSUEDT=DT
  1. I 'NUMREFS,SUGFLDT>$$FMADD^XLFDT(ISSUEDT,DAYSSUP) S $P(SUGFLDT,"^",1)=DT
  1. ;
  1. Q SUGFLDT
  1. ;
  1. VARXSIG(RXIEN) ; Returns the VistA Rx SIG (From the PRESCRIPTION file (#52))
  1. ; Input: RXIEN - Pointer to the PRESCRIPTION file (#52)
  1. ;Output: .DOSEARR - Return Array Containing Dosage Information
  1. N VARXSIG,SIG
  1. S VARXSIG="",RXIEN=+$G(RXIEN)
  1. S SIG=0 F S SIG=$O(^PSRX(RXIEN,"SIG1",SIG)) Q:'SIG D
  1. . I $E(VARXSIG,$L(VARXSIG))'=" " S VARXSIG=VARXSIG_" "
  1. . S VARXSIG=VARXSIG_$G(^PSRX(RXIEN,"SIG1",SIG,0))
  1. Q VARXSIG
  1. ;
  1. CMOPSTS(RXIEN,FILL) ; Returns the CMOP Status for the Rx Fill
  1. ; Input: RXIEN - Rx IEN (#52)
  1. ; FILL - Fill # (0 for original)
  1. ;Output: CMOP Status for the Rx Fill ("":NOT A CMOP FILL;0:TRANSMITTED;1:DISPENSED;2:RETRANSMITTED;3:NOT DISPENSED)
  1. N CMOPSTS,CMOP,Z
  1. S CMOPSTS="",CMOP=999 F S CMOP=$O(^PSRX(RXIEN,4,CMOP),-1) Q:'CMOP D I CMOPSTS="" Q
  1. . S Z=$G(^PSRX(RXIEN,4,CMOP,0))
  1. . I +$P(Z,"^",3)=FILL S CMOPSTS=$P(Z,"^",4)
  1. Q CMOPSTS