| [613] | 1 | SDUTL2 ;ALB/CAW - Misc. utilities ; 6/28/07 11:48am
|
|---|
| 2 | ;;5.3;Scheduling;**20,71,132,149,175,193,220,258,380,516**;Aug 13, 1993;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | FYNUNK(SD) ; return YES, NO, UNKNOWN
|
|---|
| 6 | ; input: SD=internal piece
|
|---|
| 7 | ; output: [returned] Y=YES, N=NO, U=UNKNOWN
|
|---|
| 8 | Q $S(SD="Y":"YES",SD="N":"NO",SD="U":"UNKNOWN",1:"")
|
|---|
| 9 | ;
|
|---|
| 10 | FMT(DFN) ; return current status of means test in external form
|
|---|
| 11 | ; input: DFN=ifn of patient
|
|---|
| 12 | ; ouput: [returned] MT^SMT^LST
|
|---|
| 13 | ; MT=external format of current status
|
|---|
| 14 | ; SMT=shortened format of current staus
|
|---|
| 15 | ; LST=date of last test
|
|---|
| 16 | ;
|
|---|
| 17 | N X,Y
|
|---|
| 18 | S X=$$LST^DGMTU(DFN)
|
|---|
| 19 | S Y=$P(X,U,4),Y=$S(Y["B":"CAT "_Y,Y["A":"COPAY EX",Y["C":"COPAY REQ",Y["G":"GMT COPAY REQ",Y["R":"REQ",Y["P":"PEND ADJ",Y["N":"NOT REQ",1:"")
|
|---|
| 20 | Q $P(X,U,3)_U_Y_U_$P(X,U,2)
|
|---|
| 21 | ;
|
|---|
| 22 | FCO(DFN) ; return current status of copay test in external form
|
|---|
| 23 | ; input: DFN=ifn of patient
|
|---|
| 24 | ; ouput: [returned] COT^SCOT^LST
|
|---|
| 25 | ; COT=external format of current status
|
|---|
| 26 | ; SCOT=shortened format of current staus
|
|---|
| 27 | ; LST=date of last test
|
|---|
| 28 | ;
|
|---|
| 29 | N X,Y
|
|---|
| 30 | S X=$$LST^DGMTU(DFN,"",2)
|
|---|
| 31 | S Y=$P(X,U,4),Y=$S(Y["E":"EXEMPT",Y["M":"NON-EXEMPT",Y["I":"INCOMPLETE",Y["L":"NO LONGER APPL.",1:"")
|
|---|
| 32 | Q $P(X,U,3)_U_Y_U_$P(X,U,2)
|
|---|
| 33 | ;
|
|---|
| 34 | XMY(GROUP,SDUZ,SDPOST) ; -- set up XMY for mail group members
|
|---|
| 35 | ; input: GROUP := mail group efn [required]
|
|---|
| 36 | ; SDUZ := send to current user [ 0|no ; 1|yes] [optional]
|
|---|
| 37 | ; SDPOST := send to postmaster if XMY is undefined
|
|---|
| 38 | ; [ 0|no ; 1|yes] [optional]
|
|---|
| 39 | ; output: XMY := array of users
|
|---|
| 40 | ; XMDUZ := message sender set postmaster
|
|---|
| 41 | ;
|
|---|
| 42 | N I K XMY
|
|---|
| 43 | I '$D(SDUZ) N SDUZ S SDUZ=1
|
|---|
| 44 | I '$D(SDPOST) N SDPOST S SDPOST=1
|
|---|
| 45 | S XMY("G."_$P($G(^XMB(3.8,GROUP,0)),U))=""
|
|---|
| 46 | I SDUZ,DUZ S XMY(DUZ)=""
|
|---|
| 47 | ; makes sure it gets sent to someone
|
|---|
| 48 | I '$D(XMY),SDPOST S XMY(.5)=""
|
|---|
| 49 | ; make postmaster the sender so it will show up as new to DUZ
|
|---|
| 50 | S XMDUZ=.5
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | SCREEN(Y,SDDT) ; -- screen called when entering a provider in the
|
|---|
| 54 | ; DEFAULT PROVIDER field (#16) or PROVIDER field (#.01) of the PROVIDER
|
|---|
| 55 | ; multiple (#2600) in the HOSPITAL LOCATION file (#44).
|
|---|
| 56 | ;
|
|---|
| 57 | ; Selects active providers with an active entry in the NEW PERSON
|
|---|
| 58 | ; file (#200) for PERSON CLASS.
|
|---|
| 59 | ;
|
|---|
| 60 | ; INPUT: Y = ien of file 200
|
|---|
| 61 | ; SDDT = today's date
|
|---|
| 62 | ; OUTPUT: 1 to select; 0 to not select
|
|---|
| 63 | ;
|
|---|
| 64 | ; begin patch *516*
|
|---|
| 65 | ; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
|
|---|
| 66 | ; The INACTIVE DATE (#53.4) field will no longer be used.
|
|---|
| 67 | ; New input selection logic...
|
|---|
| 68 | ; The TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
|
|---|
| 69 | ; will be used to determine if selection is active in the
|
|---|
| 70 | ; NEW PERSON (#200) file for a given date.
|
|---|
| 71 | ;
|
|---|
| 72 | ;S:'+$G(SDDT) SDDT=DT I '+$G(Y) Q 0
|
|---|
| 73 | ;N SDINACT,SDT,SDY S SDY=0
|
|---|
| 74 | ; check if provider active
|
|---|
| 75 | ;S SDINACT=$G(^VA(200,+Y,"PS"))
|
|---|
| 76 | ;Q:'$S(SDINACT']"":1,'+$P(SDINACT,"^",4):1,DT<+$P(SDINACT,"^",4):1,1:0) SDY
|
|---|
| 77 | ;S SDT=+$P($G(^VA(200,+Y,0)),U,11)
|
|---|
| 78 | ;Q:$S('SDT:0,(SDT<DT):1,1:0) 0
|
|---|
| 79 | ;I $$GET^XUA4A72(Y,SDDT)>0 S SDY=1
|
|---|
| 80 | ;
|
|---|
| 81 | I '+$G(Y) Q 0
|
|---|
| 82 | N SDY
|
|---|
| 83 | S:'+$G(SDDT) SDDT=DT
|
|---|
| 84 | S SDY=0,SDDT=$P(SDDT,".")
|
|---|
| 85 | I $$ACTIVPRV^PXAPI(+Y,SDDT) S SDY=1 ;DBIA #2349
|
|---|
| 86 | ; end patch *516*
|
|---|
| 87 | Q SDY
|
|---|
| 88 | ;
|
|---|
| 89 | HELP(SDDT) ; -- executable help called when entering a provider in the
|
|---|
| 90 | ; DEFAULT PROVIDER field (#16) or PROVIDER field (#.01) of the PROVIDER
|
|---|
| 91 | ; multiple (#2600) in the HOSPITAL LOCATION file (#44), the PROVIDER
|
|---|
| 92 | ; (#.01) field of the V PROVIDER file (#9000010.06), or in the
|
|---|
| 93 | ; PROVIDER prompt of the Check-out screen. display active providers
|
|---|
| 94 | ; with an active entry in the NEW PERSON file (#200) for PERSON CLASS.
|
|---|
| 95 | ;
|
|---|
| 96 | ; INPUT: SDDT = today's date
|
|---|
| 97 | ; OUTPUT: display of active providers with an active entry in the NEW
|
|---|
| 98 | ; PERSON file (#200) for PERSON CLASS
|
|---|
| 99 | ;
|
|---|
| 100 | S:'+$G(SDDT) SDDT=DT
|
|---|
| 101 | N D,DO,DIC,X
|
|---|
| 102 | S X="??",DIC="^VA(200,",DIC(0)="EQ",D="B"
|
|---|
| 103 | S DIC("S")="I $$SCREEN^SDUTL2(Y,SDDT)"
|
|---|
| 104 | D IX^DIC
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | SCAN(SDINDEX,SDBEG,SDEND,SDCB,SDFN,SDIR) ; -- api to invoke scan
|
|---|
| 108 | N SDQID
|
|---|
| 109 | D OPEN^SDQ(.SDQID)
|
|---|
| 110 | D INDEX^SDQ(.SDQID,SDINDEX,"SET")
|
|---|
| 111 | IF SDINDEX="PATIENT/DATE"!(SDINDEX="PATIENT") D PAT^SDQ(.SDQID,SDFN,"SET")
|
|---|
| 112 | IF SDINDEX="PATIENT/DATE"!(SDINDEX="DATE/TIME") D DATE^SDQ(.SDQID,SDBEG,SDEND,"SET")
|
|---|
| 113 | D SCANCB^SDQ(.SDQID,SDCB,"SET")
|
|---|
| 114 | D ACTIVE^SDQ(.SDQID,"TRUE","SET")
|
|---|
| 115 | D SCAN^SDQ(.SDQID,SDIR)
|
|---|
| 116 | D CLOSE^SDQ(.SDQID)
|
|---|
| 117 | SCANQ Q
|
|---|
| 118 | ;
|
|---|
| 119 | MHCLIN(SDCL,SDSC) ;;Determines if Mental health Clinic requiring GAF
|
|---|
| 120 | ;;This will be a supported call
|
|---|
| 121 | ;;Determines whether the clinic passed is a Mental Health clinic that requires Gaf
|
|---|
| 122 | ;;Input - SDCL = Clinic IEN
|
|---|
| 123 | ;; SDSC = DSS Stop Code [Optional]
|
|---|
| 124 | ;; For Visit File entries where the Clinic IEN is not available
|
|---|
| 125 | ;; but the DSS identifier is.
|
|---|
| 126 | ;;
|
|---|
| 127 | ;;Output - 1 = Mental health clinic requiring a Gaf
|
|---|
| 128 | ;; 0 = Not a clinic requiring a Gaf
|
|---|
| 129 | N SDNOGAF,SDSTOP,SDCS,SDMH
|
|---|
| 130 | S SDNOGAF="526,527,528,530,533,536,537,542,545,546,565,566,573,574,579"
|
|---|
| 131 | ;; Get either the Clinic IEN or the Clinic Stop code
|
|---|
| 132 | I $G(SDCL) D
|
|---|
| 133 | . S SDSTOP=$P($G(^SC(SDCL,0)),"^",7)
|
|---|
| 134 | E D
|
|---|
| 135 | . S SDSTOP=$G(SDSC)
|
|---|
| 136 | ;
|
|---|
| 137 | S SDCS=$P($G(^DIC(40.7,+SDSTOP,0)),"^",2),SDMH=$S(SDNOGAF[SDCS:0,$E(SDCS)=5:1,1:0)
|
|---|
| 138 | Q SDMH
|
|---|
| 139 | ;
|
|---|
| 140 | NEWGAF(DFN) ;;Determine if new GAF Score needed
|
|---|
| 141 | ;;This will be a supported call
|
|---|
| 142 | ;;Determines if a new Gaf is required for a patient and retrieves previous Gaf data
|
|---|
| 143 | ;; If patient is deceased, returns a 0, no new GAF required
|
|---|
| 144 | ;;
|
|---|
| 145 | ;;Input - Patient IEN
|
|---|
| 146 | ;;Output:
|
|---|
| 147 | ;; piece 1 = -1 if New Gaf needed and no previous data
|
|---|
| 148 | ;; = 1 if New Gaf needed and previous data exists
|
|---|
| 149 | ;; = 0 if no New Gaf needed and previous exists
|
|---|
| 150 | ;; piece 2 = previous Gaf score
|
|---|
| 151 | ;; piece 3 = previous Gaf date
|
|---|
| 152 | ;; piece 4 = previous Gaf Providers IEN
|
|---|
| 153 | ;;
|
|---|
| 154 | N SDGAF,SDGAFDT,VADM
|
|---|
| 155 | ;
|
|---|
| 156 | S SDGAF=$$RET^YSGAF(DFN)
|
|---|
| 157 | ;; Check for deceased patient.
|
|---|
| 158 | D DEM^VADPT
|
|---|
| 159 | Q:+$G(VADM(6)) "0^"_SDGAF_"^1"
|
|---|
| 160 | D KVAR^VADPT
|
|---|
| 161 | ;
|
|---|
| 162 | Q:SDGAF=-1 -1
|
|---|
| 163 | S X1=$P(SDGAF,"^",2),X2=90 D C^%DTC
|
|---|
| 164 | Q $S(DT>X:1,1:0)_"^"_SDGAF
|
|---|
| 165 | ;
|
|---|
| 166 | GAFCM() ;;
|
|---|
| 167 | N DIR,DIRUT
|
|---|
| 168 | S DIR("A",1)="But a new GAF Score is needed for this patient!"
|
|---|
| 169 | S DIR("A")="Are you sure you want to bypass the check out screen? "
|
|---|
| 170 | S DIR("B")="No",DIR(0)="YA" W ! D ^DIR
|
|---|
| 171 | Q +$G(Y)
|
|---|
| 172 | COLLAT(SDEC) ;Determines if patient has a collateral eligibility status
|
|---|
| 173 | ;
|
|---|
| 174 | ; INPUT: SDEC = patient eligibility status
|
|---|
| 175 | ;
|
|---|
| 176 | ; OUTPUT: 1 = collateral patient
|
|---|
| 177 | ; 0 = non-collateral patient
|
|---|
| 178 | ;
|
|---|
| 179 | Q:$G(SDEC)="" 0
|
|---|
| 180 | I $$GET1^DIQ(8,SDEC,8,"I")=13 Q 1
|
|---|
| 181 | Q 0
|
|---|
| 182 | ;
|
|---|
| 183 | ELSTAT(DA) ;Retrieve patient eligibility status
|
|---|
| 184 | ;
|
|---|
| 185 | ; INPUT: DA = patient IEN
|
|---|
| 186 | ;
|
|---|
| 187 | ; OUTPUT:
|
|---|
| 188 | ; Function Value - returns the internal entry number for patient's
|
|---|
| 189 | ; eligibility status.
|
|---|
| 190 | ;
|
|---|
| 191 | Q:$G(DA)="" ""
|
|---|
| 192 | Q $$GET1^DIQ(2,DA,.361,"I")
|
|---|
| 193 | SCREST(SCIEN,TYP,DIS) ;check stop code restriction in file 40.7 for a clinic.
|
|---|
| 194 | ; INPUT: SCIEN = IEN of Stop Code
|
|---|
| 195 | ; TYP = Stop Code Type, Primary (P) or Secondary (S)
|
|---|
| 196 | ; DIS = Message Display, 1 - Display or 0 No Display
|
|---|
| 197 | ;
|
|---|
| 198 | ; OUTPUT: 1 if no error, or 0^error message
|
|---|
| 199 | ;
|
|---|
| 200 | N SCN,RTY,CTY,RDT,STR,STYP
|
|---|
| 201 | S DIS=$G(DIS,0),STYP="("_$S(TYP="P":"Prim",1:"Second")_"ary)"
|
|---|
| 202 | I +SCIEN<1 S STR="Invalid Clinic Stop Code "_STYP_"." D MSG Q "0^"_STR
|
|---|
| 203 | S CTY=$S(TYP="P":"^P^E^",1:"^S^E^")
|
|---|
| 204 | S SCN=$G(^DIC(40.7,SCIEN,0)),RTY=$P(SCN,U,6),RDT=$P(SCN,U,7)
|
|---|
| 205 | I RTY="" D Q "0^"_STR
|
|---|
| 206 | .S STR="Clinic's Stop Code "_$P(SCN,U,2)_" has no restriction type "_STYP_"." D MSG
|
|---|
| 207 | I CTY'[("^"_RTY_"^") D D MSG Q "0^"_STR
|
|---|
| 208 | .S STR="Clinic's Stop Code "_$P(SCN,U,2)_" cannot be "_$S(TYP="P":"Prim",1:"Second")_"ary."
|
|---|
| 209 | I RDT>DT D D MSG Q "0^"_STR
|
|---|
| 210 | .S STR="Clinic's Stop Code "_$P(SCN,U,2)_" cannot be used. Restriction date is "_$$FMTE^XLFDT(RDT,"1F")_" "_STYP_"."
|
|---|
| 211 | Q 1
|
|---|
| 212 | MSG ;display error message to screen
|
|---|
| 213 | I DIS,$E($G(IOST))="C" W !?5,STR
|
|---|
| 214 | Q
|
|---|
| 215 | CLNCK(CLN,DSP) ;Check clinic for valid stop code restriction.
|
|---|
| 216 | ; INPUT: CLN = IEN of Clinic
|
|---|
| 217 | ; DSP = Error Message Display, 1 - Display or 0 No Display
|
|---|
| 218 | ;
|
|---|
| 219 | ; OUTPUT: 1 if no error or 0^error message
|
|---|
| 220 | N PSC,SSC,ND0,VAL
|
|---|
| 221 | S DSP=$G(DSP,0)
|
|---|
| 222 | I CLN="" D Q "0^"_"Invalid Clinic."
|
|---|
| 223 | .I DSP,$E($G(IOST))="C" W !?5,"Invalid Clinic."
|
|---|
| 224 | I $G(^SC(CLN,0))="" D Q "0^"_"Clinic not define or has no zero node."
|
|---|
| 225 | .I DSP,$E($G(IOST))="C" W !?5,"Clinic not define or has no zero node."
|
|---|
| 226 | S ND0=^SC(CLN,0),PSC=$P(ND0,U,7),SSC=$P(ND0,U,18),DSP=$G(DSP,0)
|
|---|
| 227 | I $P(ND0,U,3)'="C" Q 1 ;not a Clinic
|
|---|
| 228 | S VAL=$$SCREST(PSC,"P",DSP)
|
|---|
| 229 | Q:'VAL VAL Q:SSC="" 1
|
|---|
| 230 | S VAL=$$SCREST(SSC,"S",DSP)
|
|---|
| 231 | Q VAL
|
|---|
