| [613] | 1 | ACKQASU ;HCIOFO/BH-New/Edit Visit Utilities ; 04/01/99
|
|---|
| 2 | ;;3.0;QUASAR;**8,15**;Feb 11, 2000;Build 2
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ELIGCHK() ; Checks to see if there is a Primary Eligibility (which there
|
|---|
| 6 | ; always should be) if there's not (i.e. data error) pass back zero.
|
|---|
| 7 | ;
|
|---|
| 8 | N ACKFLG
|
|---|
| 9 | D ELIG^VADPT S:VAEL(1)="" ACKFLG="0" S:VAEL(1)'="" ACKFLG=1
|
|---|
| 10 | K VAEL
|
|---|
| 11 | Q ACKFLG
|
|---|
| 12 | ;
|
|---|
| 13 | DISP ; Displays headings and Patient Appointments
|
|---|
| 14 | ;
|
|---|
| 15 | ; CLEAR SCREEN WRITE FROM TOP
|
|---|
| 16 | D ENS^%ZISS
|
|---|
| 17 | W @IOF
|
|---|
| 18 | ; Get date for display
|
|---|
| 19 | D NOW^%DTC S Y=% D DD^%DT S ACKDDT1=$TR(Y,"@"," "),ACKDDT2=X
|
|---|
| 20 | S ACKSSN=$$GET1^DIQ(2,ACKPAT,".09")
|
|---|
| 21 | W " - ",IOUON,"APPOINTMENT LIST",IOUOFF," -",!
|
|---|
| 22 | W !," Name : "_$$GET1^DIQ(2,ACKPAT,".01")
|
|---|
| 23 | W ?38,"SSN : ",$E(ACKSSN,1,3)_"-"_$E(ACKSSN,4,5)_"-"_$E(ACKSSN,6,9)
|
|---|
| 24 | W !," Date : "_$E(ACKDDT2,4,5)_"/"_$E(ACKDDT2,6,7)_"/"_$E(ACKDDT2,2,3)
|
|---|
| 25 | W ?38,"Clinic : "_$$GET1^DIQ(44,ACKCLIN,.01)
|
|---|
| 26 | W !,IOUON," ",IOUOFF
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | W !!," ",IOUON,"Appt Date/Time",IOUOFF," ",IOUON,"Status",IOUOFF," ",IOUON,"Appointment Type",IOUOFF
|
|---|
| 30 | K ACKDDT1,ACKDDT2,ACKSSN
|
|---|
| 31 | ;
|
|---|
| 32 | S ACKK3=""
|
|---|
| 33 | F S ACKK3=$O(^UTILITY("VASD",$J,ACKK3)) Q:ACKK3="" D
|
|---|
| 34 | . S ACKSTRIN=^UTILITY("VASD",$J,ACKK3,"E")
|
|---|
| 35 | . W !!," "_ACKK3_"."
|
|---|
| 36 | . W ?4,$P($P(ACKSTRIN,U,1),"@",1)_" "_$P($P(ACKSTRIN,U,1),"@",2)
|
|---|
| 37 | . W ?23,$S($P(ACKSTRIN,U,3)'="":$P(ACKSTRIN,U,3),1:"NO ACTION TAKEN")
|
|---|
| 38 | . W ?49,$P(ACKSTRIN,U,4)
|
|---|
| 39 | W !!!
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | KILL ; Kill off values at end of processing
|
|---|
| 43 | K ACK0,ACK2,ACKCAT,ACKCD,ACKCDN,ACKCLN,ACKCNT,ACKCP,ACKDA,ACKDC,ACKDUP
|
|---|
| 44 | K ACKDUPN,ACKECSC,ACKESITE,ACKFLD,ACKFLG1,ACKFLG2,ACKGEN,ACKI,ACKLAYGO
|
|---|
| 45 | K ACKMOD,ACKMON,ACKQCPS,ACKQCPT,ACKQRAW,ACKRAW,ACKREQ,ACKSEL,ACKSTF
|
|---|
| 46 | K ACKSIG,ACKTM,ACKVD,ACKY,ACKDEF,ACKDIVN,ACKCSC,ACKCPNO,ACKCLNO,ACKCLIN
|
|---|
| 47 | K ACKL1,ACKL2,ACKL3,ACKL4,ACKR1,ACKR2,ACKR3,ACKR4,ACKTITL,%,%DT,%I,%X
|
|---|
| 48 | K %Y,C,D0,DA,DFN,DIC,DIE,DIK,DIRUT,DLAYGO,DR,DTOUT,DUOUT,I,J,VA,VADM
|
|---|
| 49 | K VAERR,X,X1,X4,Y,ACKELIG,ACKIEN,ACKK2,ACKLAMD,ACKLOSS,ACKN,ACKPCE
|
|---|
| 50 | K ACKVISIT,ACKPAT,ACKVIEN,ACKDIV,ACLCLIN,ACKCHK,ACKVIEN,ACKAO,ACKSC
|
|---|
| 51 | K CLINVAR,DIVARR,ACKRAD,ACKENV,ACKPROV,ACKDIAGD,ACKCPTDS,ACKDIRUT
|
|---|
| 52 | K ACKPCENO,VSAD,DIVARR,DIV,CLINVARR,ACKTME,ACKSCR,ACKELGCT,ACKELG1
|
|---|
| 53 | K ACKTRGT,ACKDVN,ACKACKBA,ACKAUDIO,ACKATS,ACKQUIT,ACKMSG,ACKQTST
|
|---|
| 54 | K ACKQSER,ACKQORG,ACKQIR,ACKQECON,ACKAPMNT,ICPTVDT,ICDVDT
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;
|
|---|
| 58 | DC ; CHECK OUT DIAGNOSTIC CONDITION - ENTER IF NEEDED
|
|---|
| 59 | N ACKY
|
|---|
| 60 | Q:$D(^ACK(509850.2,DFN,1,"B",ACKDC))
|
|---|
| 61 | S ACKY=Y D DEM^VADPT S Y=ACKY,X=$$GET1^DIQ(80,ACKDC,.01),ACKLN=$P(VADM(1),","),ACKSX=$P(VADM(5),U)
|
|---|
| 62 | I $G(ACKBGRD)'="1" D
|
|---|
| 63 | . W !!,X," ",$$DIAGTXT^ACKQUTL8(ACKDC,ACKVD)
|
|---|
| 64 | . W !,"We have no previous record of diagnostic condition ",X," for ",$S(ACKSX="F":"Ms.",1:"Mr.")," ",ACKLN,"." D ADCODE
|
|---|
| 65 | . W !,"Ok, I've added this code to ",$S(ACKSX="F":"her",1:"his")," permanent record !",!
|
|---|
| 66 | I $G(ACKBGRD)=1 D ADCODE
|
|---|
| 67 | K ACK0,ACKLN,ACKSX,VA,VADM,VAERR,X Q
|
|---|
| 68 | ;
|
|---|
| 69 | ADCODE ; Adds ICD to permanent record.
|
|---|
| 70 | N D,D0,D1,DA,DB,DC,DD,DDTM,DE,DF,DG,DH,DI,DIC,DIE,DIEL,DIFLD,DIOV,DIP,DJ,DK,DL,DM,DN,DO,DP,DQ,DR,DU,DV,DW,DXS,DZ,I,Y ;we're calling this from FM
|
|---|
| 71 | L +^ACK(509850.2,DFN,1,0) S (DIC,DIE)="^ACK(509850.2,"_DFN_",1,",DIC(0)="L",DLAYGO=509850.2,ACKLAYGO=""
|
|---|
| 72 | S DIC("P")=$P(^DD(509850.2,2,0),"^",2),DA(1)=DFN,X=ACKDC D FILE^DICN Q:Y<0 S DA=+Y,DR="2;1///"_ACKVD D ^DIE
|
|---|
| 73 | L -^ACK(509850.2,DFN,1,0) Q
|
|---|
| 74 | ;
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | GETPCETM(ACKPCENO) ; get appointment time from a PCE Visit ien
|
|---|
| 78 | ; inputs:- ACKPCENO - PCE Visit ien (from ^AUPNVSIT)
|
|---|
| 79 | ; returned :- 0^ - error (visit not found)
|
|---|
| 80 | ; '.nnnnnn^' - time portion of PCE visit date/time
|
|---|
| 81 | N ACKDATE,ACKTM
|
|---|
| 82 | K ^TMP("PXKENC",$J)
|
|---|
| 83 | D ENCEVENT^PXAPI(ACKPCENO)
|
|---|
| 84 | S ACKDATE=$P($G(^TMP("PXKENC",$J,ACKPCENO,"VST",ACKPCENO,0)),U,1)
|
|---|
| 85 | S ACKTM=$S(ACKDATE="":0,1:ACKDATE#1)
|
|---|
| 86 | K ^TMP("PXKENC",$J)
|
|---|
| 87 | Q ACKTM_U
|
|---|
| 88 | ;
|
|---|
| 89 | DUPEDATA(ACKPAT,ACKCLIN,ACKVD,ACKTM) ; If an appointment or PCE visit has been selected for a visit
|
|---|
| 90 | ; which is at the same time, for the same patient, on the same day
|
|---|
| 91 | ; within the same clinic this processing is run.
|
|---|
| 92 | ; inputs:- ACKPAT - patient ien
|
|---|
| 93 | ; ACKCLIN - clinic ien
|
|---|
| 94 | ; ACKVD - visit date (internal)
|
|---|
| 95 | ; ACKTM - appointment time (.NNN - internal)
|
|---|
| 96 | W !!?4,"ERROR - A visit already exists in QUASAR with the following details..",!
|
|---|
| 97 | W !?7,"Visit Date: ",$$DATE(ACKVD)," Appointment Time: ",$$TIME(ACKTM)
|
|---|
| 98 | W !?7," Clinic: ",$$GET1^DIQ(44,ACKCLIN_",",.01,"E")
|
|---|
| 99 | W !?7," Patient: ",$$GET1^DIQ(509850.2,ACKPAT_",",.01,"E")
|
|---|
| 100 | W !!?4,"If you choose to continue you must enter a different Appointment Time."
|
|---|
| 101 | ;
|
|---|
| 102 | ; W !!,"There is already an entry within Quasar for this Patient, within the same"
|
|---|
| 103 | ; W !,"Clinic, on the same date at the same time."
|
|---|
| 104 | ; W !!,"Enter '^' to terminate and quit back to the Division prompt"
|
|---|
| 105 | ; W !,"or <RETURN> to continue."
|
|---|
| 106 | W !
|
|---|
| 107 | K DIR S DIR(0)="E" D ^DIR K DIR ; Return to Continue '^' to Exit
|
|---|
| 108 | I X="^" Q 0
|
|---|
| 109 | Q 1
|
|---|
| 110 | ;
|
|---|
| 111 | DATE(ACKDATE) ; convert ACKDATE to external format
|
|---|
| 112 | S Y=ACKDATE D DD^%DT
|
|---|
| 113 | Q Y
|
|---|
| 114 | TIME(ACKTIME) ; convert Time to external format
|
|---|
| 115 | Q $$FMT^ACKQUTL6(ACKTIME,1)
|
|---|
