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

MHVXRXM2.m

Go to the documentation of this file.
MHVXRXM2 ;MHV/CFS - Medication extract ; [02/07/22 11:38am]
 ;;1.0;My HealtheVet;**74**;Aug 23, 2005;Build 42
 ;;Per VA Directive 6402, this routine should not be modified
 ; Copied from MHVXRX
 Q
 ;
 ;
EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract prescription data
 ; Retrieves requested prescription data and returns it in DATAROOT
 ; Retrieves all prescriptions of all statuses in given date range
 ; Statuses of deleted are filtered by the pharmacy API.
 ;
 ;  Integration Agreements:
 ;         4821 : NONVA^PSO5241
 ;         4821 : PEN^PSO5241 
 ;         4820 : RX^PSO52API
 ;         4827 : PSS^PSO59
 ;         4533 : ARWS^PSS50
 ;        10040 : Hospital Location file
 ;        10090 : Institution file
 ;         
 ;
 ;  Input:
 ;       QRY - Query array
 ;          QRY(DFN) - (required) Pointer to PATIENT (#2) file
 ;         QRY(FROM) - Date to start from
 ;           QRY(TO) - Date to go to
 ;  DATAROOT - Root of array to hold extract data
 ;
 ;  Output:
 ;  DATAROOT - Populated data array, includes # of hits
 ;       ERR - Errors during extraction
 ;
 N U,DT,HIT,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX,DFN,SIG,STAT
 N IEN,DRUGNM,DSPDT,ISSDT,LSTFDT,NXTFLDT,FLDT,RELDTTM,EXPDT,STATUS,NUM
 N QTY,DSUP,NUMRF,PROV,PORDNUM,MAIL,DIV,REMARKS,SOURCE,LIST,OTRKNM,NDC,LIST
 N CLINIC,REFDT,SCHD,NDC,TRDNM,CANDT,ORDR,ADMCLN,CMOP,DGNDC,TOTRF,UNDX,DISC,REM
 N PACTY,PADD1,PANAM,PAPHN,PASTA,PAZIP,RXCNT,TRAN,PASITE,PHPHN,REASON,RCOM
 ;
 D LOG^MHVUL2("MHVXRM EXTRACT","BEGIN","S","TRACE")
 S U="^",DT=$$DT^XLFDT
 S ERR=0,HIT=0
 K @DATAROOT
 K ^TMP($J,"MHV"),^TMP($J,"MHVNV"),^TMP($J,"MHVPD"),^TMP($J,"MHVPS"),^TMP($J,"MHVPA")
 S DFN=$G(QRY("DFN"))
 S FROM=$G(QRY("FROM"))
 S TO=$G(QRY("TO"))
 ;
 ;don't show any non active rx greater than 90 days
 S:FROM="" FROM=2000101 ;1/1/1900
 S:TO="" TO=9999999   ;If no date set to way into the future  
 ;
 D RX^PSO52API(DFN,"MHV",,,"0,3,R,P,O,M,C,A,CPRS,ST",FROM,TO)
 D PEN^PSO5241(DFN,"MHVPD")
 D NONVA^PSO5241(DFN,"MHVNV")
 ;
 D PROCESS
 ;
 K ^TMP($J,"MHV"),^TMP($J,"MHVNV"),^TMP($J,"MHVPD"),^TMP($J,"MHVPS"),^TMP($J,"MHVPA"),^TMP($J,"MHVDG"),^TMP($J,"PTR")
 D LOG^MHVUL2("MHVXRM EXTRACT","END","S","TRACE")
 Q
 ;
PROCESS ;
 S LIST="MHV"
 S INDEX=0
 F  S INDEX=$O(^TMP($J,LIST,DFN,INDEX)) Q:INDEX=""  D
 .D INIT
 .D MHV
 ;
 I ^TMP($J,"MHVNV",DFN,0)>0 D PRONV
 I ^TMP($J,"MHVPD",DFN,0)>0 D PROPD
 Q
 ;
MHV ;
 I +^TMP($J,LIST,DFN,0)=-1 Q
 S RXN=^TMP($J,LIST,DFN,INDEX,.01)
 I RXN="" Q
 S STA=$P($G(^TMP($J,LIST,DFN,INDEX,100)),"^",1)      ;status
 Q:STA=13
 D SETDATA
 D DATAROOT
 ;
 I +^TMP($J,LIST,DFN,INDEX,"RF",0)>0 D REFILL
 I +^TMP($J,LIST,DFN,INDEX,"P",0)>0 D PARTIAL
 Q
 ;
SETDATA ; setup data for original prescription
 S UNDX=""
 S MHVSTAT=$$AP2^PSOPRA(DFN,RXN)
 S MHVDATE=$P(MHVSTAT,"^",2)
 S MHVSTAT=$P(MHVSTAT,"^",1)
 I MHVSTAT>0 I $$AP5^PSOPRA(DFN,RXN)
 S IEN=INDEX
 S DRUG=$P($G(^TMP($J,LIST,DFN,INDEX,6)),"^",1)       ;drug ien
 S DRUGNM=$P($G(^TMP($J,LIST,DFN,INDEX,6)),"^",2)     ;drug name
 D GETDRG(DRUG,DRUGNM)
 S NDC=$G(^TMP($J,LIST,DFN,INDEX,27))                 ;RX NDC
 I NDC="" S NDC=DGNDC
 S DSPDT=$P($G(^TMP($J,LIST,DFN,INDEX,25)),"^",1)     ;dispense date
 S ISSDT=$P($G(^TMP($J,LIST,DFN,INDEX,1)),"^",1)      ;issue date
 S LSTFDT=$P($G(^TMP($J,LIST,DFN,INDEX,22)),"^",1)   ;last fill date
 S NXTFLDT=$P($G(^TMP($J,LIST,DFN,INDEX,102)),"^",1)  ;next fill date
 S FLDT=$P($G(^TMP($J,LIST,DFN,INDEX,22)),"^",1)      ;fill date
 S RELDTTM=$P($G(^TMP($J,LIST,DFN,INDEX,31)),"^",1)   ;release date & time
 S STAT=$P($G(^TMP($J,LIST,DFN,INDEX,100)),"^",2)      ;status
 S EXPDT=$P($G(^TMP($J,LIST,DFN,INDEX,26)),"^",1)      ;expiration date
 S STATUS=$S(STA<12&(EXPDT<DT):"EXPIRED",1:STAT)
 I STATUS["DISCONTINUED" S STATUS="DISCONTINUED"
 S QTY=$G(^TMP($J,LIST,DFN,INDEX,7))                  ;quantitY
 S DSUP=$G(^TMP($J,LIST,DFN,INDEX,8))                 ;days supply
 S (NUMRF,TOTRF)=$G(^TMP($J,LIST,DFN,INDEX,9))
 S PROV=$G(^TMP($J,LIST,DFN,INDEX,4))                 ;provider
 S PORDNUM=$P($G(^TMP($J,LIST,DFN,INDEX,39.3)),"^",1) ;placer order number
 S MAIL=$P($G(^TMP($J,LIST,DFN,INDEX,11)),"^",1)      ;mail (W/M)
 S DIV=$G(^TMP($J,LIST,DFN,INDEX,20))_U_$G(^TMP($J,LIST,DFN,INDEX,20,0))  ;division
 S REMARKS=$G(^TMP($J,LIST,DFN,INDEX,12))             ;remarks
 S SOURCE="RX"
 S TRDNM=$G(^TMP($J,LIST,DFN,INDEX,6.5))              ;trade name
 S CANDT=$P($G(^TMP($J,LIST,DFN,INDEX,26.1)),"^",1)   ;cancel date
 S CLINIC=$P($G(^TMP($J,LIST,DFN,INDEX,5)),"^",2)     ;clinic
 S CMOP=$$CMOP(INDEX,0)                               ;cmop data
 S OTRKNM=$$TRACK(INDEX,"ORIGINAL")
 S REASON=$$ACTLG(INDEX,"ORIGINAL")
 S RCOM=$P(REASON,"^",2),REASON=$P(REASON,"^",1)
 S ORDR=$P($G(^TMP($J,LIST,DFN,IEN,"OI")),"^",2)      ;ORDERABLE ITEM
 I ORDR="NO DATA FOUND" S ORDR=""
 S ADMCLN=+$G(^TMP($J,LIST,DFN,INDEX,14))              ;ADMINISTERED IN CLINIC
 S ADMCLN=$S(ADMCLN=1:"YES",1:"NO")
 S PAIEN=$P($G(^TMP($J,LIST,DFN,INDEX,20)),U,1)
 I PAIEN'="" D GETPHRM(PAIEN)
 Q
 ;
REFILL ; process refills
 N RF,TRFL
 S TRFL=$G(^TMP($J,LIST,DFN,INDEX,9))
 S RF=0
 S SOURCE="RF"
 F  S RF=$O(^TMP($J,LIST,DFN,INDEX,"RF",RF)) Q:RF=""  D SETRF(RF)
 Q
 ;
SETRF(RF) ;
 D INIT2
 S RXN=^TMP($J,LIST,DFN,INDEX,.01)
 I RXN="" Q
 D STRFDT(RF)
 D DATAROOT
 I ^TMP($J,LIST,DFN,INDEX,"M",0)=-1 S @DATAROOT@(HIT,"SIG",0)=0
 E  M @DATAROOT@(HIT,"SIG")=^TMP($J,LIST,DFN,INDEX,"M")
 Q
 ;
STRFDT(RF) ;
 S UNDX="RF"_RF
 S (FLDT,ISSDT)=$P($G(^TMP($J,LIST,DFN,INDEX,"RF",RF,.01)),"^",1)
 S DSPDT=$P($G(^TMP($J,LIST,DFN,INDEX,"RF",RF,10.1)),"^",1)
 S RELDTTM=$P($G(^TMP($J,LIST,DFN,INDEX,"RF",RF,17)),"^",1)
 S QTY=$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,1))
 S DSUP=$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,1.1))
 S PROV=$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,15))
 S MAIL=$P($G(^TMP($J,LIST,DFN,INDEX,"RF",RF,2)),"^",1)
 S DIV=$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,8))_U_$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,8,0))
 S REMARKS=$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,3))
 S NDC=$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,11))
 I NDC="" S NDC=DGNDC
 S NUMRF=TOTRF-RF
 S CMOP=$$CMOP(INDEX,RF)
 S OTRKNM=$$TRACK(INDEX,"REFILL #"_RF)
 S REASON=$$ACTLG(INDEX,"REFILL #"_RF)
 S RCOM=$P(REASON,"^",2),REASON=$P(REASON,"^",1)
 S ADMCLN=+$G(^TMP($J,LIST,DFN,INDEX,"RF",RF,23))
 S ADMCLN=$S(ADMCLN=1:"YES",1:"NO")
 S PAIEN=$P($G(^TMP($J,LIST,DFN,INDEX,"RF",RF,8)),U,1)
 I PAIEN'="" D GETPHRM(PAIEN)
 Q
 ;
PARTIAL ; process partial prescriptions
 N PF
 S PF=0
 S SOURCE="PF"
 F  S PF=$O(^TMP($J,LIST,DFN,INDEX,"P",PF)) Q:PF=""  D SETPF(PF)
 Q
 ;
SETPF(PF) ;
 D INIT2
 S RXN=$G(^TMP($J,LIST,DFN,INDEX,.01))
 I RXN="" Q
 D STPFDT(PF)
 D DATAROOT
 I ^TMP($J,LIST,DFN,INDEX,"M",0)=-1 S @DATAROOT@(HIT,"SIG",0)=0
 E  M @DATAROOT@(HIT,"SIG")=^TMP($J,LIST,DFN,INDEX,"M")
 Q
 ;
STPFDT(PF) ;
 S UNDX="PF"_PF
 S (FLDT,ISSDT)=$P($G(^TMP($J,LIST,DFN,INDEX,"P",PF,.01)),"^",1)
 S DSPDT=$P($G(^TMP($J,LIST,DFN,INDEX,"P",PF,7.5)),"^",1)
 S RELDTTM=$P($G(^TMP($J,LIST,DFN,INDEX,"P",PF,8)),"^",1)
 S QTY=$G(^TMP($J,LIST,DFN,INDEX,"P",PF,.04))
 S DSUP=$G(^TMP($J,LIST,DFN,INDEX,"P",PF,.041))
 S PROV=$G(^TMP($J,LIST,DFN,INDEX,"P",PF,6))
 S MAIL=$P($G(^TMP($J,LIST,DFN,INDEX,"P",PF,.02)),"^",1)
 S DIV=$G(^TMP($J,LIST,DFN,INDEX,"P",PF,.09))_U_$G(^TMP($J,LIST,DFN,INDEX,"P",PF,.09,0))
 S REMARKS=$G(^TMP($J,LIST,DFN,INDEX,"P",PF,.03))
 S NDC=$G(^TMP($J,LIST,DFN,INDEX,"P",PF,1))
 I NDC="" S NDC=DGNDC
 S PAIEN=$P($G(^TMP($J,LIST,DFN,INDEX,"P",PF,.09)),U,1)
 I PAIEN'="" D GETPHRM(PAIEN)
 Q
 ;
CMOP(IEN,RF) ; SET UP CMOP VARIABLES
 N CM,CMP,CMOP
 I +$G(^TMP($J,LIST,DFN,IEN,"C",0))'>0 Q ""
 S CMP=+$G(^TMP($J,LIST,DFN,IEN,"C",0))
 S CMOP=""
 I CMP>0 D
 .S CM=0 F  S CM=$O(^TMP($J,LIST,DFN,IEN,"C",CM)) Q:CM=""  D
 ..I ^TMP($J,LIST,DFN,IEN,"C",CM,2)=RF D
 ...S $P(CMOP,U,9)=$P(^TMP($J,LIST,DFN,IEN,"C",CM,9),"^",1)
 ...F I=2,3,4,10,11,12 D
 ....I $P(^TMP($J,LIST,DFN,IEN,"C",CM,I),"^",2)]"" S $P(CMOP,U,I)=$P(^TMP($J,LIST,DFN,IEN,"C",CM,I),"^",2)
 ....E  S $P(CMOP,U,I)=$P(^TMP($J,LIST,DFN,IEN,"C",CM,I),"^",1)
 Q CMOP
 ;
ACTLG(IEN,RF) ; Get info from activity log for Auto DC'ed info.
 N RSN,COM,RC,RCOM
 S (RSN,RC,COM,RCOM)=""
 S AN=0 F  S AN=$O(^TMP($J,LIST,DFN,IEN,"A",AN)) Q:AN=""  D
 .S RC=^TMP($J,LIST,DFN,IEN,"A",AN,.04)
 .I RF=RC D
 ..S COM=^TMP($J,LIST,DFN,IEN,"A",AN,.05)
 ..I COM["Rx Discontinued by EHRM Data Migration." S RSN=$P(^TMP($J,LIST,DFN,IEN,"A",AN,.02),"^",2),RCOM=COM,COM=""
 Q RSN_"^"_RCOM
 ;
TRACK(IEN,RF) ;
 N TRKN,COM,AN,RC
 S (TRKN,COM)=""
 S AN=0 F  S AN=$O(^TMP($J,LIST,DFN,IEN,"A",AN)) Q:AN=""  D
 .S RC=^TMP($J,LIST,DFN,IEN,"A",AN,.04)
 .I RF=RC,$D(^TMP($J,LIST,DFN,IEN,"A",AN,"OC")) D TRK
TRACKQ Q TRKN
 ;
TRK ;
 N TR,LINE
 S TR=0
 F  S TR=$O(^TMP($J,LIST,DFN,IEN,"A",AN,"OC",TR)) Q:TR=""  D
 .S LINE=^TMP($J,LIST,DFN,IEN,"A",AN,"OC",TR,.01)
 .I LINE["Mail Tracking Info.: " S TRKN=$P(LINE," ",4) S TRKN=$P(TRKN," ",1)
 Q
 ;
GETPHRM(PAIEN)  ;
 I '$D(^TMP($J,"MHVPA",PAIEN)) D PSS^PSO59(PAIEN,,"MHVPA")
 S PANAM=$P($G(^TMP($J,"MHVPA",PAIEN,.01)),2)
 S PADD1=$G(^TMP($J,"MHVPA",PAIEN,.02))
 S PAPHN=$G(^TMP($J,"MHVPA",PAIEN,.03))_"-"_$G(^TMP($J,"MHVPA",PAIEN,.04))
 I PAPHN="-" S PHPHN=""
 S PASITE=$G(^TMP($J,"MHVPA",PAIEN,.06))
 S PACTY=$G(^TMP($J,"MHVPA",PAIEN,.07))
 S PAZIP=$P($G(^TMP($J,"MHVPA",PAIEN,.05)),U,2)
 S PASTA=$P($G(^TMP($J,"MHVPA",PAIEN,.08)),U,2)
 Q
 ;
DATAROOT ;
 S HIT=HIT+1
 S @DATAROOT=HIT
 S @DATAROOT@(0)=DFN
 S @DATAROOT@(HIT)=$G(RXN)_U_$G(DRUG)_U_$G(MHVSTAT)_U_$G(MHVDATE)
 S @DATAROOT@(HIT,"P")=$G(PROV)
 S @DATAROOT@(HIT,"RXN")=$G(INDEX)_U_$G(DRUGNM)_U_$G(ISSDT)_U_$G(LSTFDT)_U_$G(RELDTTM)_U_$G(EXPDT)_U_$G(CANDT)_U_$G(TRDNM)
 S @DATAROOT@(HIT,"RXN1")=$G(STATUS)_U_$G(QTY)_U_$G(DSUP)_U_$G(NUMRF)_U_$G(PORDNUM)_U_$G(MAIL)_U_$G(UNDX)
 S @DATAROOT@(HIT,"RXN2")=$G(SOURCE)_U_$G(NDC)_U_$G(DSPDT)_U_$G(REASON)_U_$G(RCOM)_U_$G(CANDT)
 S @DATAROOT@(HIT,"RXN3")=$G(CLINIC)_U_$G(NXTFLDT)_U_$G(SCHD)_U_$G(OTRKNM)_U_$G(ORDR)_U_$G(ADMCLN)
 S @DATAROOT@(HIT,"PHRM")=$G(PAIEN)_U_$G(PANAM)_U_$G(PADD1)_U_$G(PAPHN)_U_$G(PACTY)_U_$G(PAZIP)_U_$G(PASTA)_U_$G(PASITE)
 S @DATAROOT@(HIT,"DIV")=$G(DIV)
 S @DATAROOT@(HIT,"CMOP")=$G(CMOP)
 I LIST="MHV" D
 .I $P(^TMP($J,LIST,DFN,INDEX,"M",0),U,1)=-1 S @DATAROOT@(HIT,"SIG",0)=0
 .E  M @DATAROOT@(HIT,"SIG")=^TMP($J,LIST,DFN,INDEX,"M")
 I LIST="MHV"!("MHVRF")!(LIST="MHVPF") D
 .I REMARKS'="" S @DATAROOT@(HIT,"RMK",1,0)=REMARKS
 .S @DATAROOT@(HIT,"RMK",0)=$S(REMARKS="":"",1:1)
 Q
 ;
PRONV ;
 S SOURCE="NV"
 S LIST="MHVNV"
 S INDEX=0
 F  S INDEX=$O(^TMP($J,LIST,DFN,INDEX)) Q:INDEX=""  Q:INDEX="B"  D MHVNV
 Q
 ;
MHVNV ;Non VA medications
 D INIT
 N DOSAGE,MEDRT,SCHED,IEN4,PAIEN,CLNUM
 S UNDX=""
 S RXN=INDEX  ;No prescription number exists
 S STATUS=$P($G(^TMP($J,LIST,DFN,INDEX,5)),"^",2)
 I STATUS="" S STATUS="ACTIVE"
 S DRUG=$P($G(^TMP($J,LIST,DFN,INDEX,1)),"^",1)
 S DRUGNM=$P($G(^TMP($J,LIST,DFN,INDEX,1)),"^",2)     ;drug name
 D GETDRG(DRUG,DRUGNM)
 S NDC=DGNDC
 S DOSAGE=$G(^TMP($J,LIST,DFN,INDEX,2))
 S MEDRT=$G(^TMP($J,LIST,DFN,INDEX,3))
 S SCHED=$G(^TMP($J,LIST,DFN,INDEX,4))
 S SIG=DOSAGE_" "_MEDRT_" "_SCHED
 S PROV=$G(^TMP($J,LIST,DFN,INDEX,12))
 S LSTFDT=$P($G(^TMP($J,LIST,DFN,INDEX,8)),"^",1)
 S ISSDT=$P($G(^TMP($J,LIST,DFN,INDEX,11)),"^",1)
 S ISSDT=$P(ISSDT,".",1)
 S EXPDT=$P($G(^TMP($J,LIST,DFN,INDEX,6)),"^",1)
 S EXPDT=$P(EXPDT,".",1)
 S CLNUM=$P($G(^TMP($J,LIST,DFN,INDEX,13)),"^",1)
 S CLINIC=$P($G(^TMP($J,LIST,DFN,INDEX,13)),"^",2)
 S REMARKS=$G(^TMP($J,LIST,DFN,INDEX,14))
 S ORDR=$P($G(^TMP($J,LIST,DFN,INDEX,.01)),"^",2)
 S IEN4=$$GET1^DIQ(44,CLNUM,3,"I") ; INSTITUTION file (#4) IEN
 S PAIEN=$$GETPTR(IEN4)
 I PAIEN'="" D GETPHRM(PAIEN)
 D DATAROOT
 S N=0 F I=0:1 S N=$O(^TMP($J,LIST,DFN,INDEX,14,N)) Q:N=""  S @DATAROOT@(HIT,"RMK",N,0)=^TMP($J,LIST,DFN,INDEX,14,N)
 S @DATAROOT@(HIT,"RMK",0)=$S(I=0:"",1:I)
 ;
 S N=0 F I=0:1 S N=$O(^TMP($J,LIST,DFN,INDEX,10,N)) Q:N=""  S @DATAROOT@(HIT,"DSC",N,0)=^TMP($J,LIST,DFN,INDEX,10,N)
 S @DATAROOT@(HIT,"DSC",0)=$S(I=0:"",1:I)
 ;
 S @DATAROOT@(HIT,"SIG",0)=1
 S @DATAROOT@(HIT,"SIG",1,0)=SIG
 Q
 ;
PROPD ; 
 S SOURCE="PD"
 S LIST="MHVPD"
 S INDEX=0
 F  S INDEX=$O(^TMP($J,LIST,DFN,INDEX)) Q:INDEX=""  Q:INDEX="B"  D MHVPD
 Q
 ;
MHVPD ;Pending Medications
 D INIT
 N N,I,CIEN
 S (RXN,IEN)=INDEX
 S UNDX=""
 S PORDNUM=$G(^TMP($J,LIST,DFN,INDEX,.01))          ; PLACER NUMBER
 S DRUG=$P($G(^TMP($J,LIST,DFN,INDEX,11)),"^",1)    ; DRUG
 S DRUGNM=$P($G(^TMP($J,LIST,DFN,INDEX,11)),"^",2)  ; drug name
 S ORDR=$P($G(^TMP($J,LIST,DFN,INDEX,8)),"^",2)     ; ORDERABLE ITEM
 D GETDRG(DRUG,DRUGNM)
 S NDC=DGNDC
 S ISSDT=$P($G(^TMP($J,LIST,DFN,INDEX,15)),"^",1)   ; LOGIN DATE 
 S ISSDT=$P(ISSDT,".",1)
 S QTY=$P($G(^TMP($J,LIST,DFN,INDEX,12)),"^",1)     ; QTANTITY
 S DSUP=$P($G(^TMP($J,LIST,DFN,INDEX,101)),"^",1)   ; DAY SUPPLY
 S NUMRF=$P($G(^TMP($J,LIST,DFN,INDEX,13)),"^",1)   ; NUMBER OF REFILLS
 S PROV=$G(^TMP($J,LIST,DFN,INDEX,5))               ; PROVIDER
 S MAIL=$P($G(^TMP($J,LIST,DFN,INDEX,19)),"^",1)    ; MAIL
 S STATUS=$P($G(^TMP($J,LIST,DFN,INDEX,2)),"^",2)   ; ORDER TYPE (NW, HD, RNW, DE, DC, RP)
 S CIEN=$P($G(^TMP($J,LIST,DFN,INDEX,100)),"^",1)   ; Related institution FILE #4 POINTER
 S CLINIC=$P($G(^TMP($J,LIST,DFN,INDEX,100)),"^",2) ; Related institution FILE #4 NAME
 S PAIEN=$$GETPTR(CIEN)
 I PAIEN'="" D GETPHRM(PAIEN)
 D DATAROOT
 S N=0 F I=0:1 S N=$O(^TMP($J,LIST,DFN,INDEX,24,N)) Q:N=""  S @DATAROOT@(HIT,"SIG",N,0)=^TMP($J,LIST,DFN,INDEX,24,N)
 S @DATAROOT@(HIT,"SIG",0)=I
 Q
 ;
GETPTR(IEN4) ; FIND PHARMACY FIELDS
 N OUT,PTR,STNM
 S STNM=$$GET1^DIQ(4,IEN4,99,"I")
 S OUT=""
 D PSS^PSO59(,"??","PTR")
 S PTR=0 F  S PTR=$O(^TMP($J,"PTR",PTR)) Q:PTR=""  Q:PTR="B"  I ^TMP($J,"PTR",PTR,.06)=STNM S OUT=PTR Q
 Q OUT
 ;
GETDRG(PSSI,PSSE) ;Drug Information
 N PSNIEN,PSNFT
 Q:PSSI=""
 D ARWS^PSS50(PSSI,PSSE,"MHVDG")
 S PSNFT=^TMP($J,"MHVDG",PSSI,21)
 S DGNDC=^TMP($J,"MHVDG",PSSI,31)
 S PSNIEN=$P(^TMP($J,"MHVDG",PSSI,22),"^",1)
 I PSNIEN="" S SCHD="Unscheduled" Q
 D DATA^PSN50P68(PSNIEN,PSNFT,"MHVPS")
 S SCHD=$P(^TMP($J,"MHVPS",PSNIEN,19),"^",2)
 Q
 ;
INIT ; set variables to null
 S (MHVDATE,MHVSTAT,IEN,DRUG,DRUGNM,DSPDT,ISSDT,LSTFDT,NXTFLDT,FLDT,RELDTTM,EXPDT,STATUS)=""
 S (QTY,DSUP,NUMRF,PROV,PORDNUM,MAIL,DIV,REMARKS,TRDNM,CANDT,OTRKNM,UNDX,DISC,REM)=""
 S (CLINIC,REFDT,SCHD,NDC,ORDR,ADMCLN,CMOP,DGNDC,REMARKS,TOTRF,REASON,RCOM)=""
 S (PANAM,PADD1,PAPHN,PACTY,PAZIP,PASTA)=""
 Q
INIT2 ;init vars for partials and refills
 S (IEN,DSPDT,ISSDT,FLDT,RELDTTM,UNDX)=""
 S (QTY,DSUP,PROV,MAIL,DIV,REMARKS,OTRKNM)=""
 S (ADMCLN,CMOP,REMARKS,REASON,RCOM,DISC,REM)=""
 S (PANAM,PADD1,PAPHN,PACTY,PAZIP,PASTA)=""