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

ACKQAS.m

Go to the documentation of this file.
  1. ACKQAS ;AUG/JLTP BIR/PTD HCIOFO/BH-New Clinic Visits ; 04/01/99
  1. ;;3.0;QUASAR;**1,10,15**;Feb 11, 2000;Build 2
  1. ;Call DEM^VADPT supported by DBIA #10061
  1. ;
  1. ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
  1. ;
  1. IVD ; INITIAL VISIT DATE ** TRIGGERED FROM PATIENT NAME ***
  1. N Y,DDD,DD,DFN,D0,%DT
  1. S DFN=X,X=$S('$D(^ACK(509850.2,DFN,0)):"",'$P(^(0),U,2):"",1:$P(^(0),U,2))
  1. I 'X D
  1. . F D Q:X=""!(X'>DT)
  1. .. S Y=ACKVD D DD^%DT S %DT="AEP",%DT("A")="INITIAL VISIT DATE: "
  1. .. S %DT("B")=Y D ^%DT K %DT S X=$S(Y<1:"",1:Y)
  1. .. I X>DT W !,"No Future Dates Allowed",!
  1. K A1
  1. Q
  1. ;
  1. VISIT ; New visit data input
  1. N ACKOUT
  1. I '$O(^ACK(509850.8,0)) W !,"A&SP site parameters must be established before visits can be entered.",! Q
  1. ;
  1. D LIST^DIC(509850.83,",1,",".01","I","*","","","","","","ACKTRGT","ACKMSG")
  1. 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
  1. ;
  1. ; Get the Division
  1. DIV ;
  1. I $D(ACKDVN),$D(CLINVARR),$P($G(ACKDVN),U,2)=1,$G(CLINVARR)<2 G VEXIT
  1. D VEXIT
  1. S ACKDVN=$$DIV^ACKQUTL2(1,.ACKDIV) G:$P(ACKDVN,U,1)="0" VEXIT
  1. I '$P(ACKDVN,U,2) W !!!!!,"No Active Divisions Set up on Site Parameters File" W ! H 1 G VEXIT
  1. S ACKDIV=$O(ACKDIV("")),ACKDIV=$P(ACKDIV(ACKDIV),U,1) ; use division IEN of Parameter file
  1. I $P(ACKDVN,U,2)>1 W " Station Number : "_$$GET1^DIQ(40.8,ACKDIV,1)
  1. ;
  1. ; Get clinic
  1. CLIN S ACKCLIN=$$CLIN^ACKQASU1(ACKDIV,"U") G:ACKCLIN=""&($P($G(ACKDVN),U,2)=1) VEXIT G:ACKCLIN="" DIV
  1. I ACKCLIN=0 W !!!!!,"No Clinics set up for Division " W ! H 1 G DIV
  1. S ACKCLIN=$P(ACKCLIN,U,1) ; Use clinic IEN from Clinic file
  1. ; Get Clinic stop code
  1. D STOP
  1. ;
  1. W !!!,"Clinic: ",$$GET1^DIQ(44,ACKCLIN,.01)," Stop Code: ",ACKCSC(1)
  1. ;
  1. ; Get visit date
  1. VDATE S DIR(0)="D^:DT:AEX",DIR("A")="Enter Visit Date",DIR("B")="TODAY"
  1. S DIR("?")="Enter the visit date or press return for TODAY. Future dates not allowed",DIR("??")="^D HELP^%DTC"
  1. D ^DIR K DIR I X?1"^"1.E W !,"Jumping not allowed." G VDATE
  1. G:$D(DIRUT) DIV
  1. S ACKVD=Y
  1. ;
  1. ;
  1. PATIENT S DIC="^ACK(509850.2,",DIC(0)="AEMQL",DLAYGO=509850.2
  1. 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"
  1. S ACKLAYGO="" D ^DIC I X?1"^"1.E W !,"Jumping not allowed." G PATIENT
  1. G:$D(DTOUT) DIV
  1. I X="^" G DIV
  1. I Y<0 W !,"This is a required response. Enter '^' to exit" G PATIENT
  1. S (ACKPAT,DFN)=+Y
  1. S ACKDFN=DFN
  1. ;; ACKQ*3*10 ADD CHECK FOR DECEASED PATIENT
  1. S ACKOUT=0
  1. D CHKDTH
  1. I ACKOUT=1 S ACKOUT=0 G PATIENT
  1. ;; END ACKQ*3*10
  1. ; Check to see if Patient has a Primary Eligibility
  1. 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
  1. ;
  1. ; check for duplicate visits (same date/same patient) allow user to select one
  1. S ACKVSEL=$$DUPCHK^ACKQASU1(ACKPAT,ACKVD) G:ACKVSEL=-1 DIV
  1. S (DA,ACKY)=ACKVSEL ; either 0 (no visit selected) or selected visit ien
  1. ;
  1. S (ACKFLG1,ACKFLG2)=0 I DA D I (ACKFLG1)!(ACKFLG2) D VEXIT G VISIT
  1. .; Compare clinic location/stop code of selected visit with
  1. .; original clinic location/stop code.
  1. .S ACKESITE=$P($G(^ACK(509850.6,ACKY,0)),U,6),ACKECSC=$P($G(^ACK(509850.6,ACKY,2)),U)
  1. .I ACKESITE'=ACKCLIN S ACKFLG1=1
  1. .I ACKECSC'=ACKCSC S ACKFLG2=1
  1. .I (ACKFLG1)!(ACKFLG2) K DA D
  1. ..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.",!
  1. ;
  1. ; Get PCE flag - 1 if division set to send to PCE else 0
  1. S ACKPCE=$$PCE^ACKQUTL4(ACKDIV,ACKVD)
  1. ;
  1. ; Existing A&SP Patient
  1. I DA D EDIT^ACKQAS5 G VISIT
  1. ;
  1. ; New visit
  1. K DD,DO,DA,D0
  1. S ACKVISIT="NEW",ACKVTME="" ; indicates this is a new visit
  1. ;
  1. ; If PCE interface not on skip to Call Template logic
  1. I 'ACKPCE S ACKVTME="" G FILE
  1. ;
  1. PCE ; Select a PCE visit
  1. ;
  1. ; Run function to check if there is a PCE visit for today
  1. I '$$PCEVST1^ACKQASU1(ACKVD,ACKPAT,ACKCLIN) G APPMNT
  1. ;
  1. ; As PCE visits must exist on the visit date run the API that displays
  1. ; them and prompts the user to either select one or add a new visit.
  1. S ACKPCENO=$$VISITLST^PXAPI(ACKPAT,ACKVD,ACKVD,ACKCLIN,"APO","","A")
  1. I ACKPCENO="-1" G DIV ; Go back to Division prompt if '^' entered
  1. S ACKVTME=""
  1. ; I ACKPCENO="A" 'ADD' selected user wishes to create new visit
  1. I ACKPCENO'="A" G FILE
  1. ;
  1. APPMNT ; Check for any appointments for the patient on this date.
  1. S VASD("C",ACKCLIN)="",VASD("T")=ACKVD,VASD("F")=ACKVD
  1. S VASD("W")="129"
  1. K ^UTILITY("VASD",$J) D SDA^VADPT
  1. I '$D(^UTILITY("VASD",$J)) G FILE ; If no appointments goto PCE check
  1. ;
  1. ; Displays headings and appointments
  1. ;
  1. D DISP^ACKQASU
  1. ;
  1. ; User is prompted to choose or create a new visit.
  1. ;
  1. APPMNT1 S ACKNUM=$O(^UTILITY("VASD",$J,""),-1)
  1. S DIR("A")=" Select Appointment (1-"_ACKNUM_") or (N)ew Visit "
  1. S DIR("B")=1
  1. S DIR("?")=" Select number on left of the list or 'N' for New Visit"
  1. S DIR(0)="F^1:2^S:X=""n"" X=""N"" K:X'=""N""&((+X<1)!(+X>ACKNUM)) X"
  1. D ^DIR K DIR,ACKNUM
  1. I X?1"^"1.E W !,"Jumping not allowed." G APPMNT1
  1. G:$D(DIRUT) DIV ; Go back to division if '^' entered.
  1. ;
  1. I X'="N"&(X'="n") S X=+X,ACKVTME=$P(^UTILITY("VASD",$J,X,"I"),U,1),ACKVTME=$P(ACKVTME,".",2),ACKAPMNT=1
  1. K ^UTILITY("VASD",$J)
  1. ;
  1. FILE ; Set up dummy record and run input template
  1. ;
  1. ; If Appointment Time is not yet known, but a PCE Visit was selected, get the time
  1. I ACKVTME="",ACKPCE,$G(ACKPCENO)'="",$G(ACKPCENO)'="A" D
  1. . S ACKVTME=$$GETPCETM^ACKQASU(ACKPCENO),ACKVTME=$P($P(ACKVTME,U,1),".",2)
  1. . I 'ACKVTME S ACKVTME="" Q
  1. ;
  1. I ACKPCE,$G(ACKAPMNT)'=1,'$$ACKAPMNT^ACKQASU7(ACKVD,ACKVTME,ACKCLIN,ACKPAT) D VEXIT,HEADING G VISIT
  1. K ACKAPMNT
  1. ;
  1. ; Check to see if entry is on 'APCE' cross ref. if so either return to
  1. ; Division prompt or null out appointment time variable.
  1. I ACKVTME'="",$D(^ACK(509850.6,"APCE",ACKPAT,ACKCLIN,ACKVD,"."_ACKVTME)) D I 'ACKQCHK D UNLOCK,VEXIT,HEADING G VISIT
  1. . S ACKQCHK=$$DUPEDATA^ACKQASU(ACKPAT,ACKCLIN,ACKVD,"."_ACKVTME)
  1. . I 'ACKQCHK Q
  1. . ; user has decided to continue, so TIME is deleted and PCE VISIT is deleted
  1. . ; this ensures that the visit is treated as brand new when sent to PCE
  1. . S ACKVTME="" ; time
  1. . S ACKPCENO="" ; pce visit ien
  1. ;
  1. ; create new visit entry
  1. ;
  1. S DIC="^ACK(509850.6,",DIC(0)="L",DLAYGO=509850.6,ACKLAYGO=""
  1. S X=ACKVD D FILE^DICN,CHKDT ; File a dummy record prior to template
  1. S ACKVIEN=+$P(Y,U,1) ; Get visit IEN from Y value.
  1. ;
  1. K ACKARR
  1. S ACKARR(509850.6,ACKVIEN_",",2.6)=ACKCLIN
  1. S ACKARR(509850.6,ACKVIEN_",",60)=ACKDIV
  1. I +ACKVTME S ACKARR(509850.6,ACKVIEN_",",55)="."_ACKVTME ; file time if known
  1. I +$G(ACKPCENO)'=0 S ACKARR(509850.6,ACKVIEN_",",125)=ACKPCENO ; file PCE number if one selected
  1. D STOP S ACKARR(509850.6,ACKVIEN_",",4)=ACKCSC ; file visit stop (required by COPYPCE)
  1. D FILE^DIE("","ACKARR")
  1. ;
  1. ; Lock the record
  1. L +^ACK(509850.6,ACKVIEN)
  1. ;
  1. ; Write away any derived PCE values to visit record
  1. I ACKPCE,$G(ACKPCENO)'="",$G(ACKPCENO)'="A" D I +ACKERR D DEL,UNLOCK,VEXIT,HEADING G VISIT
  1. . S ACKERR=$$COPYPCE^ACKQASU4(ACKVIEN,ACKPCENO)
  1. . ; if error found, display and reset ACKERR according to whether the
  1. . ; user wants to continue (SHOWPCE returns 1=exit,0=continue)
  1. . I +ACKERR S ACKERR=$$SHOWPCE^ACKQASU7($NA(^TMP("ACKQASU4",$J,"COPYPCE","ERROR")))
  1. ;
  1. ;
  1. TPLATE ; Call template
  1. S DIE="^ACK(509850.6,",(DA,ACKDA)=ACKVIEN,DR="[ACKQAS VISIT ENTRY]" D ^DIE
  1. ;
  1. K ACKREQ
  1. I $G(ACKLOSS)'="",$$AUDIO^ACKQUTL4 D UTLAUD^ACKQASU2
  1. S ACKQTST=$$POST^ACKQASU2(ACKVIEN) I 'ACKQTST S ACKDFN=DFN G TPLATE
  1. I ACKPCE,ACKQTST=1 I '$$PCESEND^ACKQASU3(ACKVIEN) S ACKDFN=DFN G TPLATE
  1. D UNLOCK,VEXIT,HEADING G VISIT
  1. ;
  1. VEXIT ; Kill off variables at end of processing
  1. ;
  1. D KILL^ACKQASU
  1. D KILL^%ZISS
  1. Q
  1. ;
  1. AOA ; COMPUTE AGE ON APPOINTMENT DATE
  1. 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
  1. Q
  1. ;
  1. CHKDT ;
  1. S ACKMON=$E(X,1,5) S ACKGEN=$S($D(^ACK(509850.7,ACKMON,0)):^(0),1:"")
  1. 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.",!
  1. Q
  1. ;
  1. SITE ;
  1. S DIR(0)="P^ACK(509850.8,1,1,:AEMQ",DA(1)=1
  1. S DIR("A")="Select Clinic Location"
  1. S DIR("?")="Choose the clinic location that should be associated with these visits."
  1. D ^DIR K DIR S:'$D(DIRUT) ACKSITE=+Y Q:$D(DIRUT)
  1. ;
  1. STOP ;
  1. S ACKCSCP=$$GET1^DIQ(44,ACKCLIN,8,"I")
  1. S ACKCSC(1)=$S('ACKCSCP:0,1:$$GET1^DIQ(40.7,ACKCSCP,1))
  1. S ACKCSC=""
  1. I ACKCSC(1)=203 S ACKCSC="A"
  1. I ACKCSC(1)=204 S ACKCSC="S"
  1. I ACKCSC="" D
  1. . S ACKCSCP=$$GET1^DIQ(44,ACKCLIN,2503,"I")
  1. . S ACKCSC(1)=$S('ACKCSCP:0,1:$$GET1^DIQ(40.7,ACKCSCP,1))
  1. . I ACKCSC(1)=203 S ACKCSC="AT"
  1. . I ACKCSC(1)=204 S ACKCSC="ST"
  1. ;
  1. K ACKCSCP
  1. Q
  1. ;
  1. ;
  1. UNLOCK ; Unlock Locked record
  1. L
  1. Q
  1. ;
  1. HEADING ;
  1. W @IOF
  1. 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.",!
  1. Q
  1. ;
  1. DEL W !!,$C(7),"<<INCOMPLETE RECORD DELETED!!>>",!!
  1. S DIK="^ACK(509850.6,",DA=ACKVIEN D ^DIK
  1. Q
  1. ;
  1. CHKDTH ;; ACKQ*3*10 ADD CHECK FOR DECEASED PATIENT
  1. N I,X,Y,ACKDIRUT,ACK,VA,VADM,VAERR
  1. D DEM^VADPT
  1. S ACK(4)=""
  1. I VADM(6)'="" D
  1. .S Y=$P(VADM(6),"^",2)
  1. .X ^DD("DD")
  1. .S ACK(4)="[PATIENT DIED ON "_$P(Y,"@")_"]"
  1. I ACK(4)'="" W !!,ACK(4),! S ACKOUT=1
  1. ;; END ACKQ*3*10
  1. Q