| 1 | IBAECP ;WOIFO/AAT-LTC SINGLE PATIENT PROFILE ; 20-FEB-02
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**171,176,199**;21-MAR-94
|
|---|
| 3 | ;; Per VHA Directive 10-93-142, this routine should not be modified
|
|---|
| 4 | ;
|
|---|
| 5 | S:'$D(DTIME) DTIME=300 D HOME^%ZIS
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | N IBQUIT,POP
|
|---|
| 9 | F S IBQUIT=0 D Q:IBQUIT
|
|---|
| 10 | . N IBDFN,IBCLK,IBDT1,IBDT2,%DT,X,Y,DIC,IBOFD,IBOEV
|
|---|
| 11 | . W !
|
|---|
| 12 | . S IBDFN=$$ASKPAT() I IBDFN=-1 S IBQUIT=1 Q
|
|---|
| 13 | . ; Enter required clock (if more than one)
|
|---|
| 14 | . S IBCLK=$$ASKCLK(IBDFN) I IBCLK<1 Q S IBQUIT=1
|
|---|
| 15 | . ; Ask about beginning and ending date and perform action
|
|---|
| 16 | . ; No default valies provided
|
|---|
| 17 | . ; W !,"The report is not available at the patch IB*2.0*171" Q
|
|---|
| 18 | . D DATE I IBDT1<0 Q S IBQUIT=1 Q ;Enter date range (defaults are begin/end of the clock)
|
|---|
| 19 | . D ASKOFD I IBOFD<0 Q S IBQUIT=1 Q ;Option - print free days
|
|---|
| 20 | . D ASKOEV I IBOEV<0 Q S IBQUIT=1 Q ;Option - print event history
|
|---|
| 21 | . D ASKDEV
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ASKDEV ; Ask about output device and print the report (or run task)
|
|---|
| 25 | N %ZIS
|
|---|
| 26 | S %ZIS="QM"
|
|---|
| 27 | W ! D ^%ZIS Q:POP ; Quit and ask for patient again. Otherwise Set IBSTOP=1
|
|---|
| 28 | ; If it was queued
|
|---|
| 29 | I $D(IO("Q")) D RUNTASK Q
|
|---|
| 30 | U IO D REPORT^IBAECP1 ; Generate report directly
|
|---|
| 31 | D ^%ZISC ; Close the device
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | ;
|
|---|
| 35 | RUNTASK ; Start Taskman job
|
|---|
| 36 | N ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
|
|---|
| 37 | S ZTRTN="REPORT^IBAECP1",ZTDESC="LTC SINGLE PATIENT BILLING PROFILE"
|
|---|
| 38 | F IBVAR="IBDFN","IBCLK","IBDT1","IBDT2","IBOFD","IBOEV" S ZTSAVE(IBVAR)=""
|
|---|
| 39 | D ^%ZTLOAD
|
|---|
| 40 | K IO("Q")
|
|---|
| 41 | D HOME^%ZIS W !
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ; User's interface for LTC Billing Clock
|
|---|
| 45 | ; If the user has only one clock - doesn't ask, only shows brief info.
|
|---|
| 46 | ; Parameters:
|
|---|
| 47 | ; IBDFN - patient IEN
|
|---|
| 48 | ; IBSHOW - if 1, the list of clocks will be printed
|
|---|
| 49 | ; Returns: LTC Clock IEN (or -1, if canceled, or 0, if the user doesn't has any clocks)
|
|---|
| 50 | ASKCLK(IBDFN,IBSHOW) N IBDT,IBDT2,IBX,IBZ,IBCNT,IBCL,DIRUT,Y,DIR,IBI,IBY,IBCLK
|
|---|
| 51 | I '$D(^IBA(351.81,"AE",IBDFN)) D Q 0 ; No data for the patient
|
|---|
| 52 | . W !,"The user doesn't have LTC Billing Clock created"
|
|---|
| 53 | ; Collect all data in IBCL array IBCL(DATE)=IEN,IBCL=<Number of clocks>
|
|---|
| 54 | S IBCL=0
|
|---|
| 55 | S IBCLK=0,IBDT=0 F S IBDT=$O(^IBA(351.81,"AE",IBDFN,IBDT)) Q:'IBDT D
|
|---|
| 56 | . S IBX=0 F S IBX=$O(^IBA(351.81,"AE",IBDFN,IBDT,IBX)) Q:'IBX D
|
|---|
| 57 | .. S IBCL(IBDT)=IBX
|
|---|
| 58 | .. S IBCL=IBCL+1
|
|---|
| 59 | ;
|
|---|
| 60 | ; If there is only one clock - no need to ask, just show
|
|---|
| 61 | I IBCL=1 S IBCLK=IBCL($O(IBCL(""))) D LSTCLK W ! Q IBCLK
|
|---|
| 62 | K Y
|
|---|
| 63 | F D Q:$D(DIRUT) Q:$D(IBCL(Y)) W " ??"
|
|---|
| 64 | . ;Choose one
|
|---|
| 65 | . I $D(Y)!($G(IBSHOW)) W ! D LSTCLK W ! ; Bad enter - list options
|
|---|
| 66 | . K DIR,DIRUT
|
|---|
| 67 | . S DIR(0)="FE"
|
|---|
| 68 | . S DIR("A")="Choose LTC BILLING CLOCK (1-"_IBCL_")"
|
|---|
| 69 | . S DIR("B")=$$FMTE^XLFDT(+$O(IBCL(""),-1),"1D")
|
|---|
| 70 | . S DIR("?")="Enter date of the required LTC BILLING CLOCK. Enter '??' for clocks list."
|
|---|
| 71 | . S DIR("??")="^D LSTCLK^IBAECP"
|
|---|
| 72 | . D ^DIR Q:$D(DIRUT)
|
|---|
| 73 | . ; User may enter just number
|
|---|
| 74 | . I Y=+Y,Y>0,Y'>IBCL D I IBY S Y=IBY Q
|
|---|
| 75 | .. S IBY="" F IBI=1:1:Y S IBY=$O(IBCL(IBY)) Q:IBY=""
|
|---|
| 76 | . S %DT="" D ^%DT ; Convert external to internal format
|
|---|
| 77 | I $D(DIRUT) Q -1
|
|---|
| 78 | W " (",$$FMTE^XLFDT(Y),")"
|
|---|
| 79 | Q IBCL(Y)
|
|---|
| 80 | ;
|
|---|
| 81 | ; Ask begin/end dates, with default values
|
|---|
| 82 | ; Input: IBCLK - LTC Clock IEN
|
|---|
| 83 | ; Output: IBDT1,IBDT2 - begin/end dates
|
|---|
| 84 | DATE N %DT,Y,IBDT,IBNOW
|
|---|
| 85 | DATAGN ;Loop entry point
|
|---|
| 86 | S (IBDT1,IBDT2)=-1
|
|---|
| 87 | ; Get beginning date
|
|---|
| 88 | S IBDT=$P($G(^IBA(351.81,IBCLK,0)),U,3)
|
|---|
| 89 | S IBDT1=$$ASKDT("Start with DATE: ",IBDT)
|
|---|
| 90 | I IBDT1<1 Q
|
|---|
| 91 | ; Get ending date
|
|---|
| 92 | S IBDT=$P($G(^IBA(351.81,IBCLK,0)),U,4)
|
|---|
| 93 | S IBNOW=$$NOW()
|
|---|
| 94 | I 'IBDT S IBDT=IBNOW
|
|---|
| 95 | E I IBDT>IBNOW S IBDT=IBNOW
|
|---|
| 96 | S IBDT2=$$ASKDT("Go to DATE: ",IBDT)
|
|---|
| 97 | I IBDT2<1 S IBDT1=-1 Q
|
|---|
| 98 | I IBDT2<IBDT1 W !,"Ending date must follow start date!",! G DATAGN
|
|---|
| 99 | Q
|
|---|
| 100 | ;
|
|---|
| 101 | ;Returns today's date in FM format
|
|---|
| 102 | NOW() N %,%H,%I,X
|
|---|
| 103 | D NOW^%DTC
|
|---|
| 104 | Q X
|
|---|
| 105 | ;
|
|---|
| 106 | ; Ask - print free days or not?
|
|---|
| 107 | ; Input: none
|
|---|
| 108 | ; Output: IBOFD (bool) IBOFD=-1 if cancelled
|
|---|
| 109 | ASKOFD ; Default - YES
|
|---|
| 110 | N DIR,Y,DUOUT
|
|---|
| 111 | S DIR(0)="Y",DIR("A")="Include DAYS NOT SUBJECT TO LTC COPAY on this report",DIR("B")="YES"
|
|---|
| 112 | D ^DIR
|
|---|
| 113 | S IBOFD=$S($G(DUOUT)!$G(DUOUT)!(Y="^"):-1,1:Y)
|
|---|
| 114 | Q
|
|---|
| 115 | ; Ask - print LTC events or not?
|
|---|
| 116 | ; Input: none
|
|---|
| 117 | ; Output: IBOEV (bool) IBOEV=-1 if cancelled
|
|---|
| 118 | ASKOEV ; Default - YES
|
|---|
| 119 | N DIR,Y,DUOUT
|
|---|
| 120 | S DIR(0)="Y",DIR("A")="Include LTC EVENTS on this report",DIR("B")="YES"
|
|---|
| 121 | D ^DIR
|
|---|
| 122 | S IBOEV=$S($G(DUOUT)!$G(DTOUT)!(Y="^"):-1,1:Y)
|
|---|
| 123 | Q
|
|---|
| 124 | ; Double question mark action - for the "enter clock" dialog
|
|---|
| 125 | ; Input:
|
|---|
| 126 | ; IBCL=<Number of clocks>
|
|---|
| 127 | ; IBCL(<Clock date>)=<Clock IEN> local array - list of clocks
|
|---|
| 128 | ; IBDFN= IEN of the patient
|
|---|
| 129 | LSTCLK N IBZ,IBDT,IBCNT,IBDT2
|
|---|
| 130 | W !,$P(^DPT(IBDFN,0),U)," has the following LTC Copay Clock",$S(IBCL>1:"s",1:""),!
|
|---|
| 131 | S IBCNT=0
|
|---|
| 132 | S IBDT=0 F S IBDT=$O(IBCL(IBDT)) Q:'IBDT D
|
|---|
| 133 | . S IBX=IBCL(IBDT)
|
|---|
| 134 | . S IBZ=^IBA(351.81,IBX,0),IBCNT=IBCNT+1
|
|---|
| 135 | . W !?10,IBCNT,?15,$$FMTE^XLFDT(IBDT)
|
|---|
| 136 | . S IBDT2=$P(IBZ,U,4)
|
|---|
| 137 | . I IBDT2 W ?28," - ",$$FMTE^XLFDT(IBDT2)
|
|---|
| 138 | . W ?48,$$EXTERNAL^DILFD(351.81,.05,"",$P(IBZ,"^",5))
|
|---|
| 139 | Q
|
|---|
| 140 | ;
|
|---|
| 141 | ; Input: prompt, default value (FM format)
|
|---|
| 142 | ; Output: date (FM) or -1, if cancelled
|
|---|
| 143 | ASKDT(IBPRMT,IBDFLT) ;Date input
|
|---|
| 144 | N DIR,Y,Y0,X,DIROUT,DIRUT
|
|---|
| 145 | I $G(IBPRMT)'="" S DIR("A")=IBPRMT
|
|---|
| 146 | I $G(IBDFLT)'="" S DIR("B")=$$FMTE^XLFDT(IBDFLT,"1D")
|
|---|
| 147 | S DIR(0)="DA"
|
|---|
| 148 | D ^DIR I $D(DIRUT) Q -1
|
|---|
| 149 | W " (",$$FMTE^XLFDT(Y),")"
|
|---|
| 150 | Q Y
|
|---|
| 151 | ;
|
|---|
| 152 | ;Enter PATIENT NAME (LTC Patients, having a clock only!)
|
|---|
| 153 | ;Customized dialog (added more explanation on '??' input)
|
|---|
| 154 | ASKPAT() N DIR,DIC,Y,X,IBDFN
|
|---|
| 155 | F D Q:$D(DIRUT) Q:Y>0
|
|---|
| 156 | . S DIR("A")="Select PATIENT NAME"
|
|---|
| 157 | . S DIR(0)="FO"
|
|---|
| 158 | . S DIR("?")="Enter '??' to list all LTC Patients"
|
|---|
| 159 | . S DIR("?",1)="Enter a name of LTC Patient"
|
|---|
| 160 | . S DIR("?",2)="Answer with PATIENT NAME, or SOCIAL SECURITY NUMBER, or last 4 digits"
|
|---|
| 161 | . S DIR("?",3)="of SOCIAL SECURITY NUMBER, or first initial of last name with last"
|
|---|
| 162 | . S DIR("?",4)="4 digits of SOCIAL SECURITY NUMBER"
|
|---|
| 163 | . S DIR("?",5)=""
|
|---|
| 164 | . S DIR("??")="^D ASKPATQQ^IBAECP"
|
|---|
| 165 | . D ^DIR Q:$D(DIRUT)
|
|---|
| 166 | . S X=Y
|
|---|
| 167 | . I X?3N1"-"2N1"-"4N.3A S X=$TR(X,"-","") ; Remove dashes from SSN
|
|---|
| 168 | . S DIC="^DPT(",DIC(0)="QME"
|
|---|
| 169 | . S DIC("S")="I $D(^IBA(351.81,""AE"",Y))"
|
|---|
| 170 | . S DIC("W")="D WRTPAT^IBAECP(+Y)"
|
|---|
| 171 | . N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
|
|---|
| 172 | . D ^DIC Q:Y<1 ; Patient code
|
|---|
| 173 | . S Y=+$G(Y)
|
|---|
| 174 | . ;W " " D WRTPAT(Y)
|
|---|
| 175 | I $D(DIRUT) Q -1
|
|---|
| 176 | Q +Y
|
|---|
| 177 | ;
|
|---|
| 178 | ASKPATQQ N DIC,X,Y,IBDFN,IBI,DIR,DIRUT,DIROUT,DTOUT,DUOUT,IBCNT
|
|---|
| 179 | D ASKPHD
|
|---|
| 180 | S IBI=7,IBCNT=0
|
|---|
| 181 | ;S DIC="^DPT",DIC(0)="F",X="??" D ^DIC
|
|---|
| 182 | S IBDFN=0 F S IBDFN=$O(^IBA(351.81,"AE",IBDFN)) Q:'IBDFN D Q:$D(DIRUT)
|
|---|
| 183 | . W ! S IBI=IBI+1
|
|---|
| 184 | . I IBI>IOSL S DIR(0)="E" D ^DIR W ! Q:$D(DIRUT) W ! S IBI=3 ; D ASKPHD S IBI=4
|
|---|
| 185 | . ; S IBCNT=IBCNT+1
|
|---|
| 186 | . ; W $J(IBCNT,4)," ",?6
|
|---|
| 187 | . D WRTPAT(IBDFN)
|
|---|
| 188 | Q
|
|---|
| 189 | ;
|
|---|
| 190 | ASKPHD ;Header
|
|---|
| 191 | N IBI
|
|---|
| 192 | W !,"Choose an LTC Patient:",!
|
|---|
| 193 | Q
|
|---|
| 194 | ;W !," LTC PATIENT NAME",?30,"BIRTH DATE",?45,"SSN",?55,"STATUS",?68,"CLK DATE"
|
|---|
| 195 | ;W ! F IBI=1:1:80 W "-"
|
|---|
| 196 | ;Q
|
|---|
| 197 | WRTPAT(IBDFN) ; Write patient's data
|
|---|
| 198 | N IBZ,IBVET,IBSC
|
|---|
| 199 | S IBZ=$G(^DPT(IBDFN,0)) Q:IBZ="" ""
|
|---|
| 200 | S IBSC=($P($G(^DPT(IBDFN,3)),U)="Y")
|
|---|
| 201 | S IBVET=($P($G(^DPT(IBDFN,"VET")),U)="Y")
|
|---|
| 202 | W $P(IBZ,U)
|
|---|
| 203 | W " ",?30,$$FMTE^XLFDT($P($P(IBZ,U,3),"."),"5MZ")
|
|---|
| 204 | W " ",?42,$$SSN($$EXTERNAL^DILFD(2,.09,"",$P(IBZ,U,9)))
|
|---|
| 205 | W " ",?55,$S(IBVET:$S(IBSC:"S/C",1:"NSC")_" VETERAN",1:"")
|
|---|
| 206 | W " ",?68,$$FMTE^XLFDT($P($O(^IBA(351.81,"AE",IBDFN,""),-1),"."),"5MZ")
|
|---|
| 207 | Q
|
|---|
| 208 | ;
|
|---|
| 209 | SSN(IBN) ;Format SSN Value
|
|---|
| 210 | I $L(+IBN)<7 Q IBN
|
|---|
| 211 | Q $E(IBN,1,3)_"-"_$E(IBN,4,5)_"-"_$E(IBN,6,255)
|
|---|
