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

ACKQASU.m

Go to the documentation of this file. 
  1. ACKQASU ;HCIOFO/BH - New/Edit Visit Utilities ;04/01/99
  1.  ;;3.0;QUASAR;**8,15,16,22,21**;Feb 11, 2000;Build 40
  1.  ;Per VHA Directive 2004-038, this routine SHOULD NOT be modified.
  1.  ;
  1.  ;  Reference/ICR
  1.  ;  $$CODEC^ICDEX - 5747
  1.  ;
  1.  ;
  1. ELIGCHK() ; Checks to see if there is a Primary Eligibility (which there
  1.  ; always should be) if there's not (i.e. data error) pass back zero.
  1.  ;         
  1.  N ACKFLG
  1.  D ELIG^VADPT S:VAEL(1)="" ACKFLG="0"  S:VAEL(1)'="" ACKFLG=1
  1.  K VAEL
  1.  Q ACKFLG
  1.  ;
  1. DISP ;  Displays headings and Patient Appointments 
  1.  ;
  1.  ;  CLEAR SCREEN WRITE FROM TOP 
  1.  D ENS^%ZISS
  1.  W @IOF
  1.  ;  Get date for display
  1.  D NOW^%DTC S Y=% D DD^%DT S ACKDDT1=$TR(Y,"@"," "),ACKDDT2=X
  1.  S ACKSSN=$$GET1^DIQ(2,ACKPAT,".09")
  1.  W "                            - ",IOUON,"APPOINTMENT LIST",IOUOFF," -",!
  1.  W !," Name : "_$$GET1^DIQ(2,ACKPAT,".01")
  1.  W ?38,"SSN    : ",$E(ACKSSN,1,3)_"-"_$E(ACKSSN,4,5)_"-"_$E(ACKSSN,6,9)
  1.  W !," Date : "_$E(ACKDDT2,4,5)_"/"_$E(ACKDDT2,6,7)_"/"_$E(ACKDDT2,2,3)
  1.  W ?38,"Clinic : "_$$GET1^DIQ(44,ACKCLIN,.01)
  1.  W !,IOUON,"                                                                                ",IOUOFF
  1.  ;
  1.  ;
  1.  W !!,"    ",IOUON,"Appt Date/Time",IOUOFF,"     ",IOUON,"Status",IOUOFF,"                    ",IOUON,"Appointment Type",IOUOFF
  1.  K ACKDDT1,ACKDDT2,ACKSSN
  1.  ;
  1.  S ACKK3=""
  1.  F  S ACKK3=$O(^UTILITY("VASD",$J,ACKK3)) Q:ACKK3=""  D
  1.  . S ACKSTRIN=^UTILITY("VASD",$J,ACKK3,"E")
  1.  . W !!," "_ACKK3_"."
  1.  . W ?4,$P($P(ACKSTRIN,U,1),"@",1)_" "_$P($P(ACKSTRIN,U,1),"@",2)
  1.  . W ?23,$S($P(ACKSTRIN,U,3)'="":$P(ACKSTRIN,U,3),1:"NO ACTION TAKEN")
  1.  . W ?49,$P(ACKSTRIN,U,4)
  1.  W !!!
  1.  Q
  1.  ;
  1. KILL ;  Kill off values at end of processing
  1.  K ACK0,ACK2,ACKCAT,ACKCD,ACKCDN,ACKCLN,ACKCNT,ACKCP,ACKDA,ACKDC,ACKDUP
  1.  K ACKDUPN,ACKECSC,ACKESITE,ACKFLD,ACKFLG1,ACKFLG2,ACKGEN,ACKI,ACKLAYGO
  1.  K ACKMOD,ACKMON,ACKQCPS,ACKQCPT,ACKQRAW,ACKRAW,ACKREQ,ACKSEL,ACKSTF
  1.  K ACKSIG,ACKTM,ACKVD,ACKY,ACKDEF,ACKDIVN,ACKCSC,ACKCPNO,ACKCLNO,ACKCLIN
  1.  K ACKL1,ACKL2,ACKL3,ACKL4,ACKR1,ACKR2,ACKR3,ACKR4,ACKTITL,%,%DT,%I,%X
  1.  K %Y,C,D0,DA,DFN,DIC,DIE,DIK,DIRUT,DLAYGO,DR,DTOUT,DUOUT,I,J,VA,VADM
  1.  K VAERR,X,X1,X4,Y,ACKELIG,ACKIEN,ACKK2,ACKLAMD,ACKLOSS,ACKN,ACKPCE
  1.  K ACKVISIT,ACKPAT,ACKVIEN,ACKDIV,ACLCLIN,ACKCHK,ACKVIEN,ACKAO,ACKSC
  1.  K CLINVAR,DIVARR,ACKRAD,ACKENV,ACKPROV,ACKDIAGD,ACKCPTDS,ACKDIRUT
  1.  K ACKPCENO,VSAD,DIVARR,DIV,CLINVARR,ACKTME,ACKSCR,ACKELGCT,ACKELG1
  1.  K ACKTRGT,ACKDVN,ACKACKBA,ACKAUDIO,ACKATS,ACKQUIT,ACKMSG,ACKQTST
  1.  K ACKQSER,ACKQORG,ACKQIR,ACKQECON,ACKAPMNT,ICPTVDT,ICDVDT,ACKHNC,ACKCV
  1.  Q
  1.  ;
  1.  ;
  1. DC ;  CHECK OUT DIAGNOSTIC CONDITION - ENTER IF NEEDED
  1.  N ACKY
  1.  Q:$D(^ACK(509850.2,DFN,1,"B",ACKDC))
  1.  ;ACKQ*3.0*22 updated api
  1.  S ACKY=Y D DEM^VADPT S Y=ACKY,X=$$CODEC^ICDEX(80,ACKDC),ACKLN=$P(VADM(1),","),ACKSX=$P(VADM(5),U)
  1.  I $G(ACKBGRD)'="1" D
  1.  . W !!,X,"   ",$$DIAGTXT^ACKQUTL8(ACKDC,ACKVD)
  1.  . W !,"We have no previous record of diagnostic condition ",X," for ",$S(ACKSX="F":"Ms.",1:"Mr.")," ",ACKLN,"." D ADCODE
  1.  . W !,"Ok, I've added this code to ",$S(ACKSX="F":"her",1:"his")," permanent record !",!
  1.  I $G(ACKBGRD)=1 D ADCODE
  1.  K ACK0,ACKLN,ACKSX,VA,VADM,VAERR,X Q
  1.  ;
  1. ADCODE ;  Adds ICD to permanent record.
  1.  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
  1.  F  L +^ACK(509850.2,DFN,1,0):$G(DILOCKTM,3) Q:$T  W:$G(ACKBGRD)'="1" !,"Another user is editing this record."
  1.  S (DIC,DIE)="^ACK(509850.2,"_DFN_",1,",DIC(0)="L",DLAYGO=509850.2,ACKLAYGO=""
  1.  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
  1.  L -^ACK(509850.2,DFN,1,0) Q
  1.  ;
  1.  Q
  1.  ;
  1. GETPCETM(ACKPCENO) ; get appointment time from a PCE Visit ien
  1.  ; inputs:- ACKPCENO - PCE Visit ien (from ^AUPNVSIT)
  1.  ; returned :-   0^ - error (visit not found)
  1.  ;               '.nnnnnn^' - time portion of PCE visit date/time
  1.  N ACKDATE,ACKTM
  1.  K ^TMP("PXKENC",$J)
  1.  D ENCEVENT^PXAPI(ACKPCENO)
  1.  S ACKDATE=$P($G(^TMP("PXKENC",$J,ACKPCENO,"VST",ACKPCENO,0)),U,1)
  1.  S ACKTM=$S(ACKDATE="":0,1:ACKDATE#1)
  1.  K ^TMP("PXKENC",$J)
  1.  Q ACKTM_U
  1.  ;
  1. DUPEDATA(ACKPAT,ACKCLIN,ACKVD,ACKTM) ;  If an appointment or PCE visit has been selected for a visit
  1.  ; which is at the same time, for the same patient, on the same day 
  1.  ; within the same clinic this processing is run.
  1.  ; inputs:- ACKPAT - patient ien
  1.  ;          ACKCLIN - clinic ien
  1.  ;          ACKVD - visit date (internal)
  1.  ;          ACKTM - appointment time (.NNN - internal)
  1.  W !!?4,"ERROR - A visit already exists in QUASAR with the following details..",!
  1.  W !?7,"Visit Date: ",$$DATE(ACKVD),"    Appointment Time: ",$$TIME(ACKTM)
  1.  W !?7,"    Clinic: ",$$GET1^DIQ(44,ACKCLIN_",",.01,"E")
  1.  W !?7,"   Patient: ",$$GET1^DIQ(509850.2,ACKPAT_",",.01,"E")
  1.  W !!?4,"If you choose to continue you must enter a different Appointment Time."
  1.  ;
  1.  ; W !!,"There is already an entry within Quasar for this Patient, within the same"
  1.  ; W !,"Clinic, on the same date at the same time."
  1.  ; W !!,"Enter '^' to terminate and quit back to the Division prompt"
  1.  ; W !,"or <RETURN> to continue."
  1.  W !
  1.  K DIR S DIR(0)="E" D ^DIR K DIR  ;  Return to Continue '^' to Exit 
  1.  I X="^" Q 0
  1.  Q 1
  1.  ;
  1. DATE(ACKDATE) ; convert ACKDATE to external format
  1.  S Y=ACKDATE D DD^%DT
  1.  Q Y
  1. TIME(ACKTIME) ; convert Time to external format
  1.  Q $$FMT^ACKQUTL6(ACKTIME,1)