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

ASDV.m

Go to the documentation of this file. 
  1. ASDV ; IHS/ANMC/LJF - CREATE VISIT AT CHECK-IN ;  [ 12/01/2000  11:10 AM ]
  1.  ;;5.0;IHS SCHEDULING;**5,7**;MAR 25, 1999
  1.  ;PATCH #5: added this routine
  1.  ;PATCH #7: requiring provider is based on clinic parameter
  1.  ;
  1. CHKIN(ASDCLN,ASDDT,APTN,DFN) ;EP; -- ask visit related check-in questions
  1.  ; called by SDI during check-in process
  1.  ; user interface for 2 questions (clinic code and provider)
  1.  ; Input variables:
  1.  ;      ASDCLN = clinic ien
  1.  ;      ASDDT  = appt date/time
  1.  ;      APTN   = ien for appt under date mutiple
  1.  ;      DFN    = patient ien
  1.  ;
  1.  Q:'$G(DFN)  Q:'$G(ASDCLN)  Q:'$G(ASDDT)  Q:'$G(APTN)
  1.  I $P($G(^SC(+ASDCLN,9999999)),U,9)'=1 Q   ;don't create visit
  1.  Q:'$G(^SC(+ASDCLN,"S",ASDDT,1,APTN,"C"))  ;not checked-in
  1.  ;
  1.  NEW ASDCC,ASDVP,ASDMSG
  1.  S ASDCC=$$CLNCODE(ASDCLN)        ;ask clinic code
  1.  S ASDVP=$$PROV(ASDCLN)           ;ask visit provider
  1.  D VISIT(ASDCLN,ASDDT,APTN,DFN,ASDCC,ASDVP,.ASDMSG)  ;create visit
  1.  ;
  1.  I $D(ASDMSG) D
  1.  . NEW I F I=1:1 Q:'$D(ASDMSG(I))  D MSG($P(ASDMSG(I),U,2),1,0)
  1.  Q
  1.  ;
  1. VISIT(ASDCLN,ASDDT,APTN,DFN,ASDCC,ASDPROV,ASDMSG) ;PEP; -- create visit
  1.  ; called by CHKIN subroutine above and by applications where
  1.  ; all data is already known
  1.  ; assumes calling routine has checked that patient is checked in
  1.  ; silent update to database; no user interface
  1.  ; Input variables:
  1.  ;      ASDCLN  = clinic ien
  1.  ;      ASDDT   = appt date/time
  1.  ;      APTN    = ien for appt under date mutiple
  1.  ;      DFN     = patient ien
  1.  ;      ASDCC   = clinic code ien
  1.  ;      ASDPROV = visit provider ien 
  1.  ;      ASDMSG  = called by reference, upon exit contains user msgs
  1.  ;                first piece is error code; 2nd piece is message
  1.  ;                Error = 0 (no problems)
  1.  ;                        1 (problem setting visit variables)
  1.  ;                        2 (problem creating visit)
  1.  ;                        3 (problem changing visit date/time)
  1.  ;
  1.  Q:'$G(ASDCLN)  Q:'$G(ASDDT)  Q:'$G(APTN)  Q:'$G(DFN)
  1.  Q:'$G(ASDCC)  ;Q:'$G(ASDPROV)   ;PATCH 7
  1.  I $P($G(^SC(+ASDCLN,9999999)),U,9)'=1 Q   ;create visit turned off
  1.  ;
  1.  ; send data to pyxis
  1.  NEW X S X="VEFSPOBS" X ^%ZOSF("TEST") I $T D
  1.  . S X=$P($G(^SC(+ASDCLN,9999999)),U,13) I X]"" D AMB^VEFSPOBS(X)
  1.  ;
  1.  ; -- set up visit variables
  1.  K APCDALVR
  1.  S APCDALVR("APCDLOC")=$$FAC(ASDCLN)                          ;facility
  1.  I 'APCDALVR("APCDLOC") D  Q
  1.  . D MSGADD(1,"Cannot create visit; can't find correct PCC facility.")
  1.  . D VSTEND
  1.  S APCDALVR("APCDPAT")=DFN                                    ;patient
  1.  S APCDALVR("APCDTYPE")=$$VALI^XBDIQ1(9001001.2,APCDALVR("APCDLOC"),.11)
  1.  S APCDALVR("APCDCAT")=$$SERCAT(ASDCLN,DFN)                   ;srv cat
  1.  S APCDALVR("APCDDATE")=$G(^SC(ASDCLN,"S",ASDDT,1,APTN,"C"))  ;chkin dt
  1.  S APCDALVR("APCDCLN")="`"_ASDCC                      ;clinic code w/`
  1.  S APCDALVR("APCDHL")=+ASDCLN                          ;clinic name
  1.  S X=$O(^DIC(19,"B","SD IHS PCC LINK",0))
  1.  I X S APCDALVR("APCDOPT")=X                           ;option used
  1.  S APCDALVR("APCDAPDT")=ASDDT                          ;appt date
  1.  S APCDALVR("APCDAPPT")=$S($P(^DPT(DFN,"S",ASDDT,0),U,7)=3:"A",$P(^DPT(DFN,"S",ASDDT,0),U,7)=4:"W",1:"U")                              ;walk-in vs appt
  1.  S APCDALVR("APCDADD")=1                               ;force add
  1.  ;
  1.  ; -- create visit
  1.  N %DT  ;per Lori - %DT(0) set somewhere in scheduling and prevents creation of visit for current or future dates
  1.  D ^APCDALV
  1.  I '$G(APCDALVR("APCDVSIT")) D  D VSTEND Q
  1.  . D MSGADD(2,"VISIT ERROR, Please notify your supervisor!")
  1.  D MSGADD(0,"Visit Created.")
  1.  S ASDVST=APCDALVR("APCDVSIT")
  1.  ;
  1.  ; -- add provider to visit
  1.  I ASDPROV D     ;add provider only if passed;PATCH 7
  1.  . K APCDALVR
  1.  . S APCDALVR("APCDTPRO")="`"_ASDPROV
  1.  . S APCDALVR("APCDPAT")=DFN
  1.  . S APCDALVR("APCDVSIT")=ASDVST
  1.  . S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1.  . S APCDALVR("APCDTPS")="P",APCDALVR("APCDTOA")=""
  1.  . D ^APCDALVR
  1.  . D MSGADD(0,"Provider added to visit.")
  1.  ;
  1.  ; -- create VCN and add to visit
  1.  I $T(VCN^AUPNVSIT)]"" S ASDVCN=$$VCN^AUPNVSIT(ASDVST,1)
  1.  ;
  1.  ; -- call to print PCC Encounter Form
  1.  ;ADD CODE HERE
  1.  ;
  1. VSTEND D EN1^APCDEKL,EN2^APCDEKL K APCDALVR,ASDVST,X
  1.  Q
  1.  ;
  1. VDATE(ASDCLN,ASDDT,APTN,DFN,ASDCKO,ASDMSG) ;EP;if new time entered, update visit
  1.  ; called by SDI if check-in time was changed
  1.  ; silent update to database; no user interface
  1.  ; Input variables:
  1.  ;    ASDCLN    =  clinic ien
  1.  ;    ASSDT     =  appt date & time
  1.  ;    APTN      =  ien for appt under date multiple
  1.  ;    DFN       =  Patient ien
  1.  ;    ASDCKO    =  old check-in date/time
  1.  ;    ASDMSG    =  called by reference, upon exit contains user msgs
  1.  ;
  1.  I $P($G(^SC(+ASDCLN,9999999)),U,9)'=1 Q   ;create visit turned off
  1.  NEW APCDVSIT,ASDCK
  1.  ;
  1.  ; find visit based on old check-in time
  1.  S APCDVSIT=$O(^AUPNVSIT("AA",DFN,$$RDT(ASDCKO),0)) Q:'APCDVSIT
  1.  I $O(^AUPNVSIT("AA",DFN,$$RDT(ASDCKO),APCDVSIT)) D MSGADD(4,"More than 1 visit at same date/time; must be updated manually.") Q   ;PATCH 7
  1.  ;
  1.  ; get new check-in time
  1.  ;S ASDCK=$G(^SC(ASDCLN,"S",ASDDT,1,APTN,"C")) Q:'ASDCK  ;PATCH 7
  1.  S ASDCK=$G(^SC(ASDCLN,"S",ASDDT,1,APTN,"C"))            ;PATCH 7
  1.  I 'ASDCK S APCDVDLT=APCDVSIT I $$GET1^DIQ(9000010,APCDVSIT,.09)<2 NEW I D EN^APCDVDLT D MSGADD(0,"Visit Deleted.") Q   ;PATCH 7 delete visit if check-in time deleted and visit has less than 2 dep entries
  1.  ;
  1.  ;if visit date/time does NOT match new check-in date/time, modify it 
  1.  I $$VALI^XBDIQ1(9000010,APCDVSIT,.01)'=ASDCK D
  1.  . S APCDCVDT("VISIT DFN")=APCDVSIT
  1.  . S APCDCVDT("VISIT DATE/TIME")=ASDCK
  1.  . D ^APCDCVDT
  1.  . I $D(APCDCVDT("ERROR FLAG")) D MSGADD(3,"Changing visit date/time failed.  Please notify your supervisor.") Q
  1.  . K APCDCVDT
  1.  . D MSGADD(0,"Visit Date/Time Updated.")
  1.  Q
  1.  ;
  1.  ;
  1.  ; subroutines called by entry points above
  1.  ;
  1. RDT(X) ; -- reverse date
  1.  Q 9999999-$P(X,".")_"."_$P(X,".",2)
  1.  ;
  1. CLNCODE(CLINIC) ; -- asks user for clinic code
  1.  NEW Y,DIR,CODE
  1.  F  Q:$G(Y)>0  D
  1.  . S DIR(0)="P^40.7:EMZQ",DIR("A")="CLINIC CODE for VISIT"
  1.  . S CODE=$$VAL^XBDIQ1(40.7,+$$VALI^XBDIQ1(44,CLINIC,8),1)  ;code #
  1.  . ;do not set default if multiple clinic codes used in clinic
  1.  . I CODE,$$VAL^XBDIQ1(44,CLINIC,9999999.14)'="YES" S DIR("B")=CODE
  1.  . S DIR("?")="This is required.  Please try again"
  1.  . D ^DIR
  1.  Q +Y
  1.  ;
  1. PROV(CLINIC) ; - asks user for visit provider
  1.  NEW DIC,X,Y
  1.  F  Q:$G(Y)>0  D
  1.  . S DIC=200,DIC(0)="AMEQZ",DIC("A")="VISIT PROVIDER:  "
  1.  . S DIC("B")=$$VAL^XBDIQ1(200,+$$VALI^XBDIQ1(44,CLINIC,9999999.8),.01)
  1.  . I DIC("B")="" K DIC("B")
  1.  . S DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
  1.  . D ^DIC K DIC
  1.  . I Y<1,$$GET1^DIQ(44,CLINIC,9999999.15)'="YES" S Y="1^QUIT" Q  ;not required;PATCH 7
  1.  . I Y<1 D MSG("This is required.  Please try again.",1,0)
  1.  I $P(Y,U,2)="QUIT" Q 0    ;not required;PATCH 7
  1.  Q $$PRVIEN(+Y)
  1.  ;
  1. PRVIEN(Y) ; -- determines correct provider file to use
  1.  I $P(^DD(9000010.06,.01,0),U,2)["200" Q +Y
  1.  Q $P(^VA(200,+Y,0),U,16)
  1.  ;
  1.  ;
  1. MSGADD(ERROR,STRING) ; -- put message string into array
  1.  NEW I
  1.  S I=$O(ASDMSG(""),-1)+1   ;get next subscript
  1.  S ASDMSG(I)=ERROR_U_STRING
  1.  Q
  1.  ;
  1. MSG(DATA,PRE,POST) ; -- writes line to device
  1.  NEW I,FORMAT
  1.  S FORMAT="" I PRE>0 F I=1:1:PRE S FORMAT=FORMAT_"!"
  1.  D EN^DDIOL(DATA,"",FORMAT)
  1.  I POST>0 F I=1:1:POST D EN^DDIOL("","","!")
  1.  Q
  1.  ;
  1. FAC(CLINIC) ; -- return facility location ien for clinic
  1.  ; try institution field in file 44, then institution based on division
  1.  ; then try user's division and make sure it is a PCC site
  1.  NEW FAC
  1.  S FAC=$$VALI^XBDIQ1(44,CLINIC,3)
  1.  I 'FAC S FAC=$$VALI^XBDIQ1(40.8,+$$VALI^XBDIQ1(44,ASDCLN,3.5),.07)
  1.  I 'FAC S FAC=$G(DUZ(2))
  1.  I '$D(^APCDSITE(+FAC)) S FAC=0
  1.  Q FAC
  1.  ;
  1. SERCAT(CLINIC,PAT) ; -- returns service category for visit
  1.  NEW CAT,CLNCAT
  1.  S CLNCAT=$$VALI^XBDIQ1(44,CLINIC,9999999.12)         ;clinic's ser cat
  1.  S CAT=$S($G(^DPT(PAT,.1))]"":"I",CLNCAT]"":CLNCAT,1:"A")  ;chk if inpt
  1.  Q CAT