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