| 1 | ACKQAS ;AUG/JLTP BIR/PTD HCIOFO/BH-New Clinic Visits ; 04/01/99
|
|---|
| 2 | ;;3.0;QUASAR;**1,10,15**;Feb 11, 2000;Build 2
|
|---|
| 3 | ;Call DEM^VADPT supported by DBIA #10061
|
|---|
| 4 | ;
|
|---|
| 5 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 6 | ;
|
|---|
| 7 | IVD ; INITIAL VISIT DATE ** TRIGGERED FROM PATIENT NAME ***
|
|---|
| 8 | N Y,DDD,DD,DFN,D0,%DT
|
|---|
| 9 | S DFN=X,X=$S('$D(^ACK(509850.2,DFN,0)):"",'$P(^(0),U,2):"",1:$P(^(0),U,2))
|
|---|
| 10 | I 'X D
|
|---|
| 11 | . F D Q:X=""!(X'>DT)
|
|---|
| 12 | .. S Y=ACKVD D DD^%DT S %DT="AEP",%DT("A")="INITIAL VISIT DATE: "
|
|---|
| 13 | .. S %DT("B")=Y D ^%DT K %DT S X=$S(Y<1:"",1:Y)
|
|---|
| 14 | .. I X>DT W !,"No Future Dates Allowed",!
|
|---|
| 15 | K A1
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | VISIT ; New visit data input
|
|---|
| 19 | N ACKOUT
|
|---|
| 20 | I '$O(^ACK(509850.8,0)) W !,"A&SP site parameters must be established before visits can be entered.",! Q
|
|---|
| 21 | ;
|
|---|
| 22 | D LIST^DIC(509850.83,",1,",".01","I","*","","","","","","ACKTRGT","ACKMSG")
|
|---|
| 23 | I '$P($G(ACKTRGT("DILIST",0)),U,1) W !,"No Divisions have been set up select the Site Parameters function to set up",!,"Division entries.",! Q
|
|---|
| 24 | ;
|
|---|
| 25 | ; Get the Division
|
|---|
| 26 | DIV ;
|
|---|
| 27 | I $D(ACKDVN),$D(CLINVARR),$P($G(ACKDVN),U,2)=1,$G(CLINVARR)<2 G VEXIT
|
|---|
| 28 | D VEXIT
|
|---|
| 29 | S ACKDVN=$$DIV^ACKQUTL2(1,.ACKDIV) G:$P(ACKDVN,U,1)="0" VEXIT
|
|---|
| 30 | I '$P(ACKDVN,U,2) W !!!!!,"No Active Divisions Set up on Site Parameters File" W ! H 1 G VEXIT
|
|---|
| 31 | S ACKDIV=$O(ACKDIV("")),ACKDIV=$P(ACKDIV(ACKDIV),U,1) ; use division IEN of Parameter file
|
|---|
| 32 | I $P(ACKDVN,U,2)>1 W " Station Number : "_$$GET1^DIQ(40.8,ACKDIV,1)
|
|---|
| 33 | ;
|
|---|
| 34 | ; Get clinic
|
|---|
| 35 | CLIN S ACKCLIN=$$CLIN^ACKQASU1(ACKDIV,"U") G:ACKCLIN=""&($P($G(ACKDVN),U,2)=1) VEXIT G:ACKCLIN="" DIV
|
|---|
| 36 | I ACKCLIN=0 W !!!!!,"No Clinics set up for Division " W ! H 1 G DIV
|
|---|
| 37 | S ACKCLIN=$P(ACKCLIN,U,1) ; Use clinic IEN from Clinic file
|
|---|
| 38 | ; Get Clinic stop code
|
|---|
| 39 | D STOP
|
|---|
| 40 | ;
|
|---|
| 41 | W !!!,"Clinic: ",$$GET1^DIQ(44,ACKCLIN,.01)," Stop Code: ",ACKCSC(1)
|
|---|
| 42 | ;
|
|---|
| 43 | ; Get visit date
|
|---|
| 44 | VDATE S DIR(0)="D^:DT:AEX",DIR("A")="Enter Visit Date",DIR("B")="TODAY"
|
|---|
| 45 | S DIR("?")="Enter the visit date or press return for TODAY. Future dates not allowed",DIR("??")="^D HELP^%DTC"
|
|---|
| 46 | D ^DIR K DIR I X?1"^"1.E W !,"Jumping not allowed." G VDATE
|
|---|
| 47 | G:$D(DIRUT) DIV
|
|---|
| 48 | S ACKVD=Y
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | PATIENT S DIC="^ACK(509850.2,",DIC(0)="AEMQL",DLAYGO=509850.2
|
|---|
| 52 | S DIC("W")="N ACKA,ACKB S ACKA=$$GET1^DIQ(2,Y,.03),ACKB=$$GET1^DIQ(2,Y,.09),ACKA=$E(ACKA,1,2)_""-""_$E(ACKA,4,5)_""-""_$E(ACKA,9,10) W ?36,ACKA_"" ""_ACKB"
|
|---|
| 53 | S ACKLAYGO="" D ^DIC I X?1"^"1.E W !,"Jumping not allowed." G PATIENT
|
|---|
| 54 | G:$D(DTOUT) DIV
|
|---|
| 55 | I X="^" G DIV
|
|---|
| 56 | I Y<0 W !,"This is a required response. Enter '^' to exit" G PATIENT
|
|---|
| 57 | S (ACKPAT,DFN)=+Y
|
|---|
| 58 | S ACKDFN=DFN
|
|---|
| 59 | ;; ACKQ*3*10 ADD CHECK FOR DECEASED PATIENT
|
|---|
| 60 | S ACKOUT=0
|
|---|
| 61 | D CHKDTH
|
|---|
| 62 | I ACKOUT=1 S ACKOUT=0 G PATIENT
|
|---|
| 63 | ;; END ACKQ*3*10
|
|---|
| 64 | ; Check to see if Patient has a Primary Eligibility
|
|---|
| 65 | I '$$ELIGCHK^ACKQASU W !!,"DATA ERROR : Patient has no Primary Eligibility defined on the Patient File.",!,"This requires updating before QUASAR processing can commence.",! D VEXIT G DIV
|
|---|
| 66 | ;
|
|---|
| 67 | ; check for duplicate visits (same date/same patient) allow user to select one
|
|---|
| 68 | S ACKVSEL=$$DUPCHK^ACKQASU1(ACKPAT,ACKVD) G:ACKVSEL=-1 DIV
|
|---|
| 69 | S (DA,ACKY)=ACKVSEL ; either 0 (no visit selected) or selected visit ien
|
|---|
| 70 | ;
|
|---|
| 71 | S (ACKFLG1,ACKFLG2)=0 I DA D I (ACKFLG1)!(ACKFLG2) D VEXIT G VISIT
|
|---|
| 72 | .; Compare clinic location/stop code of selected visit with
|
|---|
| 73 | .; original clinic location/stop code.
|
|---|
| 74 | .S ACKESITE=$P($G(^ACK(509850.6,ACKY,0)),U,6),ACKECSC=$P($G(^ACK(509850.6,ACKY,2)),U)
|
|---|
| 75 | .I ACKESITE'=ACKCLIN S ACKFLG1=1
|
|---|
| 76 | .I ACKECSC'=ACKCSC S ACKFLG2=1
|
|---|
| 77 | .I (ACKFLG1)!(ACKFLG2) K DA D
|
|---|
| 78 | ..W !!,"The "_$S(ACKFLG1:"clinic location",1:"clinic stop code")_" for the selected appointment does not match",!,"the current "_$S(ACKFLG1:"clinic location",1:"clinic stop code")_". Transaction not allowed.",!
|
|---|
| 79 | ;
|
|---|
| 80 | ; Get PCE flag - 1 if division set to send to PCE else 0
|
|---|
| 81 | S ACKPCE=$$PCE^ACKQUTL4(ACKDIV,ACKVD)
|
|---|
| 82 | ;
|
|---|
| 83 | ; Existing A&SP Patient
|
|---|
| 84 | I DA D EDIT^ACKQAS5 G VISIT
|
|---|
| 85 | ;
|
|---|
| 86 | ; New visit
|
|---|
| 87 | K DD,DO,DA,D0
|
|---|
| 88 | S ACKVISIT="NEW",ACKVTME="" ; indicates this is a new visit
|
|---|
| 89 | ;
|
|---|
| 90 | ; If PCE interface not on skip to Call Template logic
|
|---|
| 91 | I 'ACKPCE S ACKVTME="" G FILE
|
|---|
| 92 | ;
|
|---|
| 93 | PCE ; Select a PCE visit
|
|---|
| 94 | ;
|
|---|
| 95 | ; Run function to check if there is a PCE visit for today
|
|---|
| 96 | I '$$PCEVST1^ACKQASU1(ACKVD,ACKPAT,ACKCLIN) G APPMNT
|
|---|
| 97 | ;
|
|---|
| 98 | ; As PCE visits must exist on the visit date run the API that displays
|
|---|
| 99 | ; them and prompts the user to either select one or add a new visit.
|
|---|
| 100 | S ACKPCENO=$$VISITLST^PXAPI(ACKPAT,ACKVD,ACKVD,ACKCLIN,"APO","","A")
|
|---|
| 101 | I ACKPCENO="-1" G DIV ; Go back to Division prompt if '^' entered
|
|---|
| 102 | S ACKVTME=""
|
|---|
| 103 | ; I ACKPCENO="A" 'ADD' selected user wishes to create new visit
|
|---|
| 104 | I ACKPCENO'="A" G FILE
|
|---|
| 105 | ;
|
|---|
| 106 | APPMNT ; Check for any appointments for the patient on this date.
|
|---|
| 107 | S VASD("C",ACKCLIN)="",VASD("T")=ACKVD,VASD("F")=ACKVD
|
|---|
| 108 | S VASD("W")="129"
|
|---|
| 109 | K ^UTILITY("VASD",$J) D SDA^VADPT
|
|---|
| 110 | I '$D(^UTILITY("VASD",$J)) G FILE ; If no appointments goto PCE check
|
|---|
| 111 | ;
|
|---|
| 112 | ; Displays headings and appointments
|
|---|
| 113 | ;
|
|---|
| 114 | D DISP^ACKQASU
|
|---|
| 115 | ;
|
|---|
| 116 | ; User is prompted to choose or create a new visit.
|
|---|
| 117 | ;
|
|---|
| 118 | APPMNT1 S ACKNUM=$O(^UTILITY("VASD",$J,""),-1)
|
|---|
| 119 | S DIR("A")=" Select Appointment (1-"_ACKNUM_") or (N)ew Visit "
|
|---|
| 120 | S DIR("B")=1
|
|---|
| 121 | S DIR("?")=" Select number on left of the list or 'N' for New Visit"
|
|---|
| 122 | S DIR(0)="F^1:2^S:X=""n"" X=""N"" K:X'=""N""&((+X<1)!(+X>ACKNUM)) X"
|
|---|
| 123 | D ^DIR K DIR,ACKNUM
|
|---|
| 124 | I X?1"^"1.E W !,"Jumping not allowed." G APPMNT1
|
|---|
| 125 | G:$D(DIRUT) DIV ; Go back to division if '^' entered.
|
|---|
| 126 | ;
|
|---|
| 127 | I X'="N"&(X'="n") S X=+X,ACKVTME=$P(^UTILITY("VASD",$J,X,"I"),U,1),ACKVTME=$P(ACKVTME,".",2),ACKAPMNT=1
|
|---|
| 128 | K ^UTILITY("VASD",$J)
|
|---|
| 129 | ;
|
|---|
| 130 | FILE ; Set up dummy record and run input template
|
|---|
| 131 | ;
|
|---|
| 132 | ; If Appointment Time is not yet known, but a PCE Visit was selected, get the time
|
|---|
| 133 | I ACKVTME="",ACKPCE,$G(ACKPCENO)'="",$G(ACKPCENO)'="A" D
|
|---|
| 134 | . S ACKVTME=$$GETPCETM^ACKQASU(ACKPCENO),ACKVTME=$P($P(ACKVTME,U,1),".",2)
|
|---|
| 135 | . I 'ACKVTME S ACKVTME="" Q
|
|---|
| 136 | ;
|
|---|
| 137 | I ACKPCE,$G(ACKAPMNT)'=1,'$$ACKAPMNT^ACKQASU7(ACKVD,ACKVTME,ACKCLIN,ACKPAT) D VEXIT,HEADING G VISIT
|
|---|
| 138 | K ACKAPMNT
|
|---|
| 139 | ;
|
|---|
| 140 | ; Check to see if entry is on 'APCE' cross ref. if so either return to
|
|---|
| 141 | ; Division prompt or null out appointment time variable.
|
|---|
| 142 | I ACKVTME'="",$D(^ACK(509850.6,"APCE",ACKPAT,ACKCLIN,ACKVD,"."_ACKVTME)) D I 'ACKQCHK D UNLOCK,VEXIT,HEADING G VISIT
|
|---|
| 143 | . S ACKQCHK=$$DUPEDATA^ACKQASU(ACKPAT,ACKCLIN,ACKVD,"."_ACKVTME)
|
|---|
| 144 | . I 'ACKQCHK Q
|
|---|
| 145 | . ; user has decided to continue, so TIME is deleted and PCE VISIT is deleted
|
|---|
| 146 | . ; this ensures that the visit is treated as brand new when sent to PCE
|
|---|
| 147 | . S ACKVTME="" ; time
|
|---|
| 148 | . S ACKPCENO="" ; pce visit ien
|
|---|
| 149 | ;
|
|---|
| 150 | ; create new visit entry
|
|---|
| 151 | ;
|
|---|
| 152 | S DIC="^ACK(509850.6,",DIC(0)="L",DLAYGO=509850.6,ACKLAYGO=""
|
|---|
| 153 | S X=ACKVD D FILE^DICN,CHKDT ; File a dummy record prior to template
|
|---|
| 154 | S ACKVIEN=+$P(Y,U,1) ; Get visit IEN from Y value.
|
|---|
| 155 | ;
|
|---|
| 156 | K ACKARR
|
|---|
| 157 | S ACKARR(509850.6,ACKVIEN_",",2.6)=ACKCLIN
|
|---|
| 158 | S ACKARR(509850.6,ACKVIEN_",",60)=ACKDIV
|
|---|
| 159 | I +ACKVTME S ACKARR(509850.6,ACKVIEN_",",55)="."_ACKVTME ; file time if known
|
|---|
| 160 | I +$G(ACKPCENO)'=0 S ACKARR(509850.6,ACKVIEN_",",125)=ACKPCENO ; file PCE number if one selected
|
|---|
| 161 | D STOP S ACKARR(509850.6,ACKVIEN_",",4)=ACKCSC ; file visit stop (required by COPYPCE)
|
|---|
| 162 | D FILE^DIE("","ACKARR")
|
|---|
| 163 | ;
|
|---|
| 164 | ; Lock the record
|
|---|
| 165 | L +^ACK(509850.6,ACKVIEN)
|
|---|
| 166 | ;
|
|---|
| 167 | ; Write away any derived PCE values to visit record
|
|---|
| 168 | I ACKPCE,$G(ACKPCENO)'="",$G(ACKPCENO)'="A" D I +ACKERR D DEL,UNLOCK,VEXIT,HEADING G VISIT
|
|---|
| 169 | . S ACKERR=$$COPYPCE^ACKQASU4(ACKVIEN,ACKPCENO)
|
|---|
| 170 | . ; if error found, display and reset ACKERR according to whether the
|
|---|
| 171 | . ; user wants to continue (SHOWPCE returns 1=exit,0=continue)
|
|---|
| 172 | . I +ACKERR S ACKERR=$$SHOWPCE^ACKQASU7($NA(^TMP("ACKQASU4",$J,"COPYPCE","ERROR")))
|
|---|
| 173 | ;
|
|---|
| 174 | ;
|
|---|
| 175 | TPLATE ; Call template
|
|---|
| 176 | S DIE="^ACK(509850.6,",(DA,ACKDA)=ACKVIEN,DR="[ACKQAS VISIT ENTRY]" D ^DIE
|
|---|
| 177 | ;
|
|---|
| 178 | K ACKREQ
|
|---|
| 179 | I $G(ACKLOSS)'="",$$AUDIO^ACKQUTL4 D UTLAUD^ACKQASU2
|
|---|
| 180 | S ACKQTST=$$POST^ACKQASU2(ACKVIEN) I 'ACKQTST S ACKDFN=DFN G TPLATE
|
|---|
| 181 | I ACKPCE,ACKQTST=1 I '$$PCESEND^ACKQASU3(ACKVIEN) S ACKDFN=DFN G TPLATE
|
|---|
| 182 | D UNLOCK,VEXIT,HEADING G VISIT
|
|---|
| 183 | ;
|
|---|
| 184 | VEXIT ; Kill off variables at end of processing
|
|---|
| 185 | ;
|
|---|
| 186 | D KILL^ACKQASU
|
|---|
| 187 | D KILL^%ZISS
|
|---|
| 188 | Q
|
|---|
| 189 | ;
|
|---|
| 190 | AOA ; COMPUTE AGE ON APPOINTMENT DATE
|
|---|
| 191 | N DFN,VA,VADM,VAERR,X1,X2 S DFN=$P(^ACK(509850.6,D0,0),U,2),X1=$P(^(0),U) D DEM^VADPT S X2=+VADM(3),X=X1-X2\10000
|
|---|
| 192 | Q
|
|---|
| 193 | ;
|
|---|
| 194 | CHKDT ;
|
|---|
| 195 | S ACKMON=$E(X,1,5) S ACKGEN=$S($D(^ACK(509850.7,ACKMON,0)):^(0),1:"")
|
|---|
| 196 | Q:'$L(ACKGEN) I $P(ACKGEN,U,4) W !!,$C(7),"Capitation data for that time period has already been compiled.",!,"To insure proper credit for this visit, please make sure the capitation",!,"data is regenerated.",!
|
|---|
| 197 | Q
|
|---|
| 198 | ;
|
|---|
| 199 | SITE ;
|
|---|
| 200 | S DIR(0)="P^ACK(509850.8,1,1,:AEMQ",DA(1)=1
|
|---|
| 201 | S DIR("A")="Select Clinic Location"
|
|---|
| 202 | S DIR("?")="Choose the clinic location that should be associated with these visits."
|
|---|
| 203 | D ^DIR K DIR S:'$D(DIRUT) ACKSITE=+Y Q:$D(DIRUT)
|
|---|
| 204 | ;
|
|---|
| 205 | STOP ;
|
|---|
| 206 | S ACKCSCP=$$GET1^DIQ(44,ACKCLIN,8,"I")
|
|---|
| 207 | S ACKCSC(1)=$S('ACKCSCP:0,1:$$GET1^DIQ(40.7,ACKCSCP,1))
|
|---|
| 208 | S ACKCSC=""
|
|---|
| 209 | I ACKCSC(1)=203 S ACKCSC="A"
|
|---|
| 210 | I ACKCSC(1)=204 S ACKCSC="S"
|
|---|
| 211 | I ACKCSC="" D
|
|---|
| 212 | . S ACKCSCP=$$GET1^DIQ(44,ACKCLIN,2503,"I")
|
|---|
| 213 | . S ACKCSC(1)=$S('ACKCSCP:0,1:$$GET1^DIQ(40.7,ACKCSCP,1))
|
|---|
| 214 | . I ACKCSC(1)=203 S ACKCSC="AT"
|
|---|
| 215 | . I ACKCSC(1)=204 S ACKCSC="ST"
|
|---|
| 216 | ;
|
|---|
| 217 | K ACKCSCP
|
|---|
| 218 | Q
|
|---|
| 219 | ;
|
|---|
| 220 | ;
|
|---|
| 221 | UNLOCK ; Unlock Locked record
|
|---|
| 222 | L
|
|---|
| 223 | Q
|
|---|
| 224 | ;
|
|---|
| 225 | HEADING ;
|
|---|
| 226 | W @IOF
|
|---|
| 227 | W !,"This option is used to enter new A&SP clinic visits. Existing clinic",!,"visits should be updated with the Edit an Existing Visit option.",!
|
|---|
| 228 | Q
|
|---|
| 229 | ;
|
|---|
| 230 | DEL W !!,$C(7),"<<INCOMPLETE RECORD DELETED!!>>",!!
|
|---|
| 231 | S DIK="^ACK(509850.6,",DA=ACKVIEN D ^DIK
|
|---|
| 232 | Q
|
|---|
| 233 | ;
|
|---|
| 234 | CHKDTH ;; ACKQ*3*10 ADD CHECK FOR DECEASED PATIENT
|
|---|
| 235 | N I,X,Y,ACKDIRUT,ACK,VA,VADM,VAERR
|
|---|
| 236 | D DEM^VADPT
|
|---|
| 237 | S ACK(4)=""
|
|---|
| 238 | I VADM(6)'="" D
|
|---|
| 239 | .S Y=$P(VADM(6),"^",2)
|
|---|
| 240 | .X ^DD("DD")
|
|---|
| 241 | .S ACK(4)="[PATIENT DIED ON "_$P(Y,"@")_"]"
|
|---|
| 242 | I ACK(4)'="" W !!,ACK(4),! S ACKOUT=1
|
|---|
| 243 | ;; END ACKQ*3*10
|
|---|
| 244 | Q
|
|---|
