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

SDAMOL1.m

Go to the documentation of this file. 
  1. SDAMOL1 ;ALB/CAW - Retroactive Appointment List (con't);4/15/92 ; 2/16/07 2:59pm
  1.  ;;5.3;Scheduling;**132,466,460,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;02/16/07  SD*5.3*466  Applied 466 changes to include inpatients
  1.  ;09/27/05  SD*5.3*460    Direct access to patient appointments is now encapsulated
  1.  ;                        via SDAPI API. SDAPI supports distributed appointment files
  1.  ;                        (whether actual files are located in VistA DB or non-VistA DB).
  1.  ;                        -- M.M.
  1.  ;****************************************************************************************
  1.  ;
  1. MAIN ; main sort, by division
  1.  N SDTMP,SDX,SDTMP1,SDTMP2
  1.  K ^TMP("SDRL",$J),^TMP("SDRAL",$J)
  1.  ;
  1.  ; -- get list of database close out dates
  1.  S SDTMP=SDBEG
  1.  F  D  S SDTMP=$$NEXTDT(SDTMP) Q:SDTMP>SDEND
  1.  . S SDX=$P($$CLOSEOUT^SCDXFU04(SDTMP),U,SDNPDB)
  1.  . IF SDX'=-1 S ^TMP("SDRL",$J,SDTMP)=SDX
  1.  ;
  1.  I ($D(VAUTC)>1)!($D(VAUTS)>1) D  ; Return Appts for Specifc Clinics/Stop Codes.
  1.  .N SDARRAY,SDERR,SDRESULT K ^TMP($J,"SDAMA301")
  1.  .S SDARRAY(1)=SDBEG_";"_SDEND ; Date Range of Appts.
  1.  .I $D(VAUTC)>1 S SDARRAY(2)="VAUTC(" ; Search Appts for Selected Clinics.
  1.  .I $D(VAUTS)>1 D  ; Search Appts for Selected Stop Codes.
  1.  ..S (SDARRAY(13),SDTMP1)=""
  1.  ..F  S SDTMP1=$O(VAUTS(SDTMP1)) Q:SDTMP1=""  D
  1.  ...S SDTMP2=+$P($G(^DIC(40.7,SDTMP1,0)),"^",2) I SDTMP2<1 Q
  1.  ...S SDARRAY(13)=SDARRAY(13)_SDTMP2_";"
  1.  .S SDARRAY("FLDS")="16",SDRESULT=$$SDAPI^SDAMA301(.SDARRAY)
  1.  .I SDRESULT<1 D  D MAINQ Q  ; SDAPI Returned an Error.
  1.  ..S SDERR=$$SDAPIERR^SDAMUTDT() I $L(SDERR) W !!,SDERR,! D OUT^SDUTL
  1.  ;
  1.  D SCAN
  1.  D BLD^SDAMOLP
  1.  ;
  1. MAINQ ; -- exit logic
  1.  K SDDV,SDSC,SDCLK,SDCLNM,SDCN,SDCNT,SDAD,SDATA,SDDFN,SDCLIN
  1.  K SDCLINIC,SDCLC,SDASH,SDCSC,SDDIV,SDDATE,SDAPPT,SDFLEN,SDFLG
  1.  K SDPAT,SDPAGE,SDSLEN,SDFST,SDROU,SDSEC,SDSTOP,SDSTPC,SDSTPCDE
  1.  K SDTYPE,SDVISIT,SDWHEN,SDVDT,SDVST,SDVSTDT,SDY,SDTRANS,SDTMP
  1.  K VA,VAERR,X,^TMP("SDRAL",$J),^TMP($J,"SDAMA301")
  1.  Q
  1.  ;
  1. SCAN ; -- api to invoke scan
  1.  ;
  1.  ; -- send message to task manager and check for stop request
  1.  IF $$S^%ZTLOAD("Searching for Retroactive Encounters...") S ZTSTOP=1 G SCANQ
  1.  N SDCB,SDQID
  1.  S SDCB="D CB^SDAMOL1(.Y,.Y0,.SDSTOP)"
  1.  D OPEN^SDQ(.SDQID)
  1.  D ACTIVE^SDQ(.SDQID,"FALSE","SET")
  1.  D INDEX^SDQ(.SDQID,"DATE/TIME","SET")
  1.  D DATE^SDQ(.SDQID,SDBEG,SDEND,"SET")
  1.  D SCANCB^SDQ(.SDQID,SDCB,"SET")
  1.  D ACTIVE^SDQ(.SDQID,"TRUE","SET")
  1.  D SCAN^SDQ(.SDQID,"FORWARD")
  1.  D CLOSE^SDQ(.SDQID)
  1. SCANQ Q
  1.  ;
  1.  ;
  1. CB(SDOE,SDOE0,SDSTOP) ; -- main callback
  1.  N SDVISIT,SDVSTDT,SDPAT,SDSC,SDCL,SDOEP,SDORG,SDEXT,SDDIV,SDOEU
  1.  N SDCLK,SDWHEN,SDCLNM,SDSTPCDE,SDTYPE,SDVSIT,SDCODT,SDSTATUS
  1.  ;
  1.  ; -- has user asked to stop job ; if yes, kill data & quit
  1.  IF $$S^%ZTLOAD() D  G CBQ
  1.  . S (SDSTOP,ZTSTOP)=1
  1.  . K ^TMP("SDRAL",$J)
  1.  ;
  1.  ; -- set up variables for data fields
  1.  S SDVISIT=SDOE
  1.  S SDVSTDT=+SDOE0
  1.  S SDPAT=+$P(SDOE0,U,2)
  1.  S SDSC=+$P(SDOE0,U,3)
  1.  S SDCL=+$P(SDOE0,U,4)
  1.  S SDVSIT=+$P(SDOE0,U,5)
  1.  S SDOEP=+$P(SDOE0,U,6)
  1.  S SDCODT=+$P(SDOE0,U,7)
  1.  S SDORG=+$P(SDOE0,U,8)
  1.  S SDEXT=+$P(SDOE0,U,9)
  1.  S SDDIV=+$P(SDOE0,U,11)
  1.  S SDSTATUS=+$P(SDOE0,U,12)
  1.  S SDOEU=$G(^SCE(SDOE,"USER"))
  1.  S SDCLK=+SDOEU
  1.  S SDWHEN=+$P(SDOEU,U,4)
  1.  ;
  1.  ; -- drived data
  1.  IF 'SDWHEN,SDORG=1,SDEXT S SDWHEN=+$$APPT^SDAMOL1(SDCL,SDPAT,SDVSTDT) ; Return 'Date Appt Made'.
  1.  IF 'SDWHEN S SDWHEN=+$P($G(^AUPNVSIT(SDVSIT,0)),U,2)
  1.  S SDCLNM=$P($G(^SC(SDCL,0),0),U)
  1.  S SDSTPCDE=+$P($G(^DIC(40.7,SDSC,0)),U,2)
  1.  S SDTYPE=$S(SDORG=1:"APPOINTMENT",SDORG=2:"STANDALONE",SDORG=3:"DISPOSITION",1:"UNKNOWN")
  1.  ;
  1.  ; -- quit if encounter has parent
  1.  IF SDOEP G CBQ
  1.  ;
  1.  ; -- quit if no 'created' date found
  1.  IF 'SDWHEN G CBQ
  1.  ;
  1.  ; -- quit if 'created' before close out date
  1.  IF '$$TMP(+SDOE0,SDWHEN) G CBQ
  1.  ;
  1.  ; -- quit if no checked out completion date/time
  1.  IF 'SDCODT G CBQ
  1.  ;
  1.  ; -- quit if not status is not 'checked out' or 'inpatient'
  1.  IF "^8^2^"'[("^"_SDSTATUS_"^") G CBQ
  1.  ;
  1.  ;-- quit if non-count clinic
  1.  IF $P($G(^SC(SDCL,0)),U,17)="Y" G CBQ
  1.  ;
  1.  ; -- quit if division or clinic or stop code not valid for report
  1.  IF '$$DIV() G CBQ
  1.  IF '$$CLINIC() G CBQ
  1.  IF '$$STOP() G CBQ
  1.  ;
  1.  D SET
  1. CBQ Q
  1.  ;
  1.  ;
  1. NEXTDT(X1) ; -- get next date
  1.  N X2
  1.  S X2=1 D C^%DTC
  1.  Q X
  1.  ;
  1. SET ;^TMP("SDRAL",$J,Division,Stop Code,Visit Date,Patient)
  1.  ;
  1.  S ^TMP("SDRAL",$J,SDDIV,SDSTPCDE,SDVSTDT,SDPAT)=SDVISIT_U_SDWHEN_U_SDCLK_U_SDTYPE_U_^TMP("SDRL",$J,$P(SDVSTDT,"."))_U_SDCLNM
  1. SETQ Q
  1.  ;
  1. TMP(SDENCDT,SDMADE) ; -- Check to see if ^TMP("SDRL",$J,Encounter Date/Time)
  1.  ;                    exists
  1.  ;  input - SDENCDT := encounter date/time
  1.  ;          SDMADE  := date encounter made
  1.  ;
  1.  ; output - 1 or 0
  1.  ;
  1.  IF '$D(^TMP("SDRL",$J,$P(SDENCDT,"."))) Q 0
  1.  Q ^TMP("SDRL",$J,$P(SDENCDT,"."))<(SDMADE_.9)
  1.  ;
  1. DIV() ; -- valid division for report ?
  1.  Q $S(VAUTD=1:1,1:$D(VAUTD(SDDIV)))
  1.  ;
  1. CLINIC() ; -- valid clinic for report ?
  1.  Q $S('$D(VAUTC):1,VAUTC=1:1,1:$D(VAUTC(SDCL)))
  1.  ;
  1. STOP() ; -- valid stop code for report ?
  1.  Q $S('$D(VAUTS):1,VAUTS=1:1,1:$D(VAUTS(SDSC)))
  1.  ;
  1. APPT(SDCL,SDPAT,SDVSTDT) ; Return 'Date Appt Made' field.
  1.  ; If user selected specific Clinic or Stop Code then SDAPI has been called in line tag MAIN+nnn above.
  1.  I ($D(VAUTC)>1)!($D(VAUTS)>1) Q $P($G(^TMP($J,"SDAMA301",SDPAT,SDCL,SDVSTDT)),U,16)
  1.  ;
  1.  ; If User selected ALL Clinics/Stop Codes then search for specific Appt.
  1.  N SDARRAY,SDERR,SDRESULT K ^TMP($J,"SDAMA301")
  1.  S SDARRAY(1)=SDVSTDT ; Specific Date of Appt.
  1.  S SDARRAY(2)=SDCL ; Specific Clinic.
  1.  S SDARRAY(4)=SDPAT ;  Specific Patient.
  1.  S SDARRAY("MAX")=1 ; Should Return Only One Appt.
  1.  S SDARRAY("FLDS")="16",SDRESULT=$$SDAPI^SDAMA301(.SDARRAY)
  1.  I SDRESULT<1 D  Q 0  ; SDAPI Returned an Error.
  1.  .S SDERR=$$SDAPIERR^SDAMUTDT() I $L(SDERR) W !!,SDERR,! D OUT^SDUTL
  1.  Q $P($G(^TMP($J,"SDAMA301",SDPAT,SDCL,SDVSTDT)),U,16)  ; Return Date Appt Made.
  1.  ;