SDOQMP ;ALB/SCK - Appointment Monitoring / Performance Measure report ; [07/17/96]
;;5.3;SCHEDULING;**47,1015**;AUG 13,1993;Build 21
Q
;
EN ; Entry point for Access PM extract to be sent to data collection server
;
Q:$$CHKTASK^SDOQMP0
D INIT,LOOP,START^SDOQMP2,BLDPME
D END^SDOQMP1
Q
;
EN1 ; Entry point for interactive appointment monitoring report
;
N XT,XT1,CONT,PMSEL
;
S PMSEL=$$SELECT^SDOQMP0
Q:PMSEL']""
;
I PMSEL="C" G EN1Q:'$$CLINIC^SDOQMP0
I PMSEL="S" G EN1Q:'$$STOP^SDOQMP0
I PMSEL="D" G EN1Q:'$$DIV^SDOQMP0
;
F XT=1:1 S XT1=$P($T(MSG+XT),";;",2) Q:XT1="$$END" W !,XT1
AGN S CONT=0
S %ZIS="Q" D ^%ZIS G:POP EN1Q
;
I IOM'=132 D G:'CONT AGN
. S:$E(IOST,1,2)="C-" DIR("A",1)="It's not recommended to print this report to screen."
. S DIR(0)="Y^A",DIR("A")="Do you want to select another device?",DIR("B")="YES"
. S DIR("A",2)="The selected device does not have 132 columns."
. D ^DIR K DIR
. S:$D(DIRUT)!(Y=0) CONT=1
;
QUE I $D(IO("Q")) D G EN1Q
. S ZTRTN="START^SDOQMP",ZTDESC="Appointment Monitoring Report"
. S:PMSEL="C" ZTSAVE("CLINIC(")="",ZTSAVE("CLINIC")=""
. S:PMSEL="S" ZTSAVE("VAUTC(")="",ZTSAVE("VAUTC")=""
. S:PMSEL="D" ZTSAVE("VAUTD(")="",ZTSAVE("VAUTD")=""
. D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
. D HOME^%ZIS K IO("Q")
;
D WAIT^DICD
START D INIT,LOOPS^SDOQMP0,START^SDOQMP2,BLDRPT
;
EN1Q D:'$D(ZTQUEUED) ^%ZISC
D END^SDOQMP1
K CLINIC,^TMP("SDAMMS"),^TMP("SDPM"),VAUTD,VAUTC,^TMP("SDMSG")
Q
;
INIT ; Initialize date arrays for calculating next available appointments
;
S:'$D(U) U="^"
K ^TMP("SDAMMS"),^TMP("SDPM"),^TMP("APPT")
S ^TMP("SDAMMS",$J,"MGN")=80,(CNT,CNT1,CNT2,CNT3,CNT4)=0,IOM=80
S ^TMP("SDAMMS",$J,"PG")=0,$P(^TMP("SDAMMS",$J,"="),"=",IOM)=""
S X="T" D ^%DT S DT=Y X ^DD("DD") S ^TMP("SDAMMS",$J,"DT")=Y
S X="T" D ^%DT S AMMSRDT=Y
S ^TMP("SDPM",$J,0)=DT
S AMMSCNT="",AMMSLAST=0,AMMSZDT=DT,AMMSFDT=20,AMMSFSL=33
D DATES^SDOQMP1
Q
;
LOOP ; Loop through the clinics in the Hospital location file. Use only those clinics with
; an associated stop code on the required list for the access performance measure
;
; Variables
; AMMSD0 - Clinic IEN
;
S AMMSD0=0
F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
. Q:'$$CLNOK^SDOQMP0($P($G(^SC(AMMSD0,0)),"^",7))
. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
Q
;
LOOPC ; Loop through the clinics in the hospital location file. User can select
; one-many-all clinics through this entry point.
;
; Variables
; AMMSD0 - Clinic IEN
; CLINIC - Clinic array returned from VAUTOMA
;
S AMMSD0=0
; Select all
I CLINIC=1 D
. F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
.. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
.. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
.. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
;
; Select One-Many
I CLINIC=0&($D(CLINIC)) D
. F S AMMSD0=$O(CLINIC(AMMSD0)) Q:'AMMSD0 D
.. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
.. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
.. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
Q
;
BLDPME ; Build the data array to be included in the mail message.
; If the number of data lines in the current array goes over 100,
; Send the array and begin building a new one.
;
; Data String format:
; Clinic Name^Date Run^Date of Next Appt.^# of Days^Stop code^Division
;
N X,LC,PMNODE,PMDT,PMMSG,PMCLNI,PMCLNE,PMAPT
;
K ^TMP("SDMSG")
S X=$G(^TMP("SDPM",$J,0)),PMDT=$P(X,U)
S LC=1,PMCLNI=0
;
F S PMCLNI=$O(^TMP("SDPM",$J,PMCLNI)) Q:'PMCLNI D
. S PMNODE=$G(^TMP("SDPM",$J,PMCLNI,PMDT))
. S PMCLNE=$P($G(^SC(PMCLNI,0)),U)
. S PMAPT=$P(PMNODE,U)
. S X2=PMDT,X1=PMAPT D ^%DTC
. S ^TMP("SDMSG",$J,LC)=PMCLNE_U_PMDT_U_PMAPT_U_$S(X']"":-1,1:X)_U_$$STOPCDE^SDOQMP0(PMCLNI)_U_$$DIVISION^SDOQMP0(PMCLNI)
. S LC=LC+1
;
D:LC>350 PRCLRG
I LC'>350 D PRCSML
DMQ Q
;
PRCSML ; Process clinic lists smaller than 500 entries
N PMMSG,LC
S (X,LC)=0
F S X=$O(^TMP("SDMSG",$J,X)) Q:'X D
. S LC=LC+1
. S PMMSG(LC)=^TMP("SDMSG",$J,X)
D MAIL(.PMMSG,LC)
Q
;
PRCLRG ; Process clinic lists greater than 500 entries
N SDTMP,XF,XL,XC
S XF=1,XL=350
;
LP1 F XC=XF:1:XL Q:XC'<LC D
. S SDTMP(XC)=^TMP("SDMSG",$J,XC)
;
D MAIL(.SDTMP,LC,XC)
;
S XF=XL+1,XL=XL+350
K SDTMP
G:XC<LC LP1
Q
;
MAIL(PMDATA,LINCNT,CNT) ; Send data message to server.
; The data message is sent to the local notification mail group,
; the notification mail group at the server domain, and the
; server at the data collection server domain
;
; Server
; A1BO PM NEXT APPT EXTRACT at Albany ISC
;
; Variables
; MSG - Data array to be sent
; LINCNT - Number of lines in the data array
;
; Message Format
; Header - $START^Site Name^Facility Number^Date.Time run^Domain Name^Total lines^Last line sent
; Body - data array (see BLDPME)
; Tail - $END
;
N XC,X1,%DT,XMB,PMFAC,XMLOC
;
S XMLOC=0
S XMDUZ=.5
S XMY(".5")=""
S XMY("S.A1BO PM NEXT APPT EXTRACT@DEVFEX.ISC-ALBANY.VA.GOV")=""
S XMY("G.SD PM NOTIFICATION")=""
S XMY("G.SD PM EXTRACT@ISC-ALBANY.VA.GOV")=""
;
S PMFAC=$$SITE^VASITE
D NOW^%DTC
;
S PMDATA(.01)="$START^"_$P($G(PMFAC),"^",2,3)_"^"_%_"^"_$G(^XMB("NETNAME"))_"^"_LINCNT_"^"_$G(CNT)
S PMDATA(LINCNT+1)="$END"
;
S XMTEXT="PMDATA("
S XMSUB="Access PM Extract from "_$P($G(PMFAC),U,2),XMN=0
D ^XMD
K XMDUZ,XMN,XMSUB,XMTEXT,XMY
SMQ Q
;
BLDRPT ; Call the entry point to print the Appointment Monitoring report
D START^SDOQMPR
Q
;
MSG ; Message displayed to user when the EN1 entry point is used.
;;
;;This report requires 132 columns and could take a long time
;;to print depending on the number of clinics selected.
;;Please remember to QUEUE it.
;;$$END
SDOQMP ;ALB/SCK - Appointment Monitoring / Performance Measure report ; [07/17/96]
+1 ;;5.3;SCHEDULING;**47,1015**;AUG 13,1993;Build 21
+2 QUIT
+3 ;
EN ; Entry point for Access PM extract to be sent to data collection server
+1 ;
+2 IF $$CHKTASK^SDOQMP0
QUIT
+3 DO INIT
DO LOOP
DO START^SDOQMP2
DO BLDPME
+4 DO END^SDOQMP1
+5 QUIT
+6 ;
EN1 ; Entry point for interactive appointment monitoring report
+1 ;
+2 NEW XT,XT1,CONT,PMSEL
+3 ;
+4 SET PMSEL=$$SELECT^SDOQMP0
+5 IF PMSEL']""
QUIT
+6 ;
+7 IF PMSEL="C"
IF '$$CLINIC^SDOQMP0
GOTO EN1Q
+8 IF PMSEL="S"
IF '$$STOP^SDOQMP0
GOTO EN1Q
+9 IF PMSEL="D"
IF '$$DIV^SDOQMP0
GOTO EN1Q
+10 ;
+11 FOR XT=1:1
SET XT1=$PIECE($TEXT(MSG+XT),";;",2)
IF XT1="$$END"
QUIT
WRITE !,XT1
AGN SET CONT=0
+1 SET %ZIS="Q"
DO ^%ZIS
IF POP
GOTO EN1Q
+2 ;
+3 IF IOM'=132
Begin DoDot:1
+4 IF $EXTRACT(IOST,1,2)="C-"
SET DIR("A",1)="It's not recommended to print this report to screen."
+5 SET DIR(0)="Y^A"
SET DIR("A")="Do you want to select another device?"
SET DIR("B")="YES"
+6 SET DIR("A",2)="The selected device does not have 132 columns."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)!(Y=0)
SET CONT=1
End DoDot:1
IF 'CONT
GOTO AGN
+9 ;
QUE IF $DATA(IO("Q"))
Begin DoDot:1
+1 SET ZTRTN="START^SDOQMP"
SET ZTDESC="Appointment Monitoring Report"
+2 IF PMSEL="C"
SET ZTSAVE("CLINIC(")=""
SET ZTSAVE("CLINIC")=""
+3 IF PMSEL="S"
SET ZTSAVE("VAUTC(")=""
SET ZTSAVE("VAUTC")=""
+4 IF PMSEL="D"
SET ZTSAVE("VAUTD(")=""
SET ZTSAVE("VAUTD")=""
+5 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"TASK #: ",ZTSK
+6 DO HOME^%ZIS
KILL IO("Q")
End DoDot:1
GOTO EN1Q
+7 ;
+8 DO WAIT^DICD
START DO INIT
DO LOOPS^SDOQMP0
DO START^SDOQMP2
DO BLDRPT
+1 ;
EN1Q IF '$DATA(ZTQUEUED)
DO ^%ZISC
+1 DO END^SDOQMP1
+2 KILL CLINIC,^TMP("SDAMMS"),^TMP("SDPM"),VAUTD,VAUTC,^TMP("SDMSG")
+3 QUIT
+4 ;
INIT ; Initialize date arrays for calculating next available appointments
+1 ;
+2 IF '$DATA(U)
SET U="^"
+3 KILL ^TMP("SDAMMS"),^TMP("SDPM"),^TMP("APPT")
+4 SET ^TMP("SDAMMS",$JOB,"MGN")=80
SET (CNT,CNT1,CNT2,CNT3,CNT4)=0
SET IOM=80
+5 SET ^TMP("SDAMMS",$JOB,"PG")=0
SET $PIECE(^TMP("SDAMMS",$JOB,"="),"=",IOM)=""
+6 SET X="T"
DO ^%DT
SET DT=Y
XECUTE ^DD("DD")
SET ^TMP("SDAMMS",$JOB,"DT")=Y
+7 SET X="T"
DO ^%DT
SET AMMSRDT=Y
+8 SET ^TMP("SDPM",$JOB,0)=DT
+9 SET AMMSCNT=""
SET AMMSLAST=0
SET AMMSZDT=DT
SET AMMSFDT=20
SET AMMSFSL=33
+10 DO DATES^SDOQMP1
+11 QUIT
+12 ;
LOOP ; Loop through the clinics in the Hospital location file. Use only those clinics with
+1 ; an associated stop code on the required list for the access performance measure
+2 ;
+3 ; Variables
+4 ; AMMSD0 - Clinic IEN
+5 ;
+6 SET AMMSD0=0
+7 FOR
SET AMMSD0=$ORDER(^SC("AC","C",AMMSD0))
IF 'AMMSD0
QUIT
Begin DoDot:1
+8 IF '$PIECE($GET(^SC(AMMSD0,0)),"^",7)
QUIT
+9 IF '$$CLNOK^SDOQMP0($PIECE($GET(^SC(AMMSD0,0)),"^",7))
QUIT
+10 IF $GET(^TMP("SDAMMS",$JOB,"Q"))=1
QUIT
+11 FOR X1=1:1:3
DO AMMSCNT^SDOQMP1
IF AMMSLAST=0
QUIT
End DoDot:1
+12 QUIT
+13 ;
LOOPC ; Loop through the clinics in the hospital location file. User can select
+1 ; one-many-all clinics through this entry point.
+2 ;
+3 ; Variables
+4 ; AMMSD0 - Clinic IEN
+5 ; CLINIC - Clinic array returned from VAUTOMA
+6 ;
+7 SET AMMSD0=0
+8 ; Select all
+9 IF CLINIC=1
Begin DoDot:1
+10 FOR
SET AMMSD0=$ORDER(^SC("AC","C",AMMSD0))
IF 'AMMSD0
QUIT
Begin DoDot:2
+11 IF '$PIECE($GET(^SC(AMMSD0,0)),"^",7)
QUIT
+12 IF $GET(^TMP("SDAMMS",$JOB,"Q"))=1
QUIT
+13 FOR X1=1:1:3
DO AMMSCNT^SDOQMP1
IF AMMSLAST=0
QUIT
End DoDot:2
End DoDot:1
+14 ;
+15 ; Select One-Many
+16 IF CLINIC=0&($DATA(CLINIC))
Begin DoDot:1
+17 FOR
SET AMMSD0=$ORDER(CLINIC(AMMSD0))
IF 'AMMSD0
QUIT
Begin DoDot:2
+18 IF '$PIECE($GET(^SC(AMMSD0,0)),"^",7)
QUIT
+19 IF $GET(^TMP("SDAMMS",$JOB,"Q"))=1
QUIT
+20 FOR X1=1:1:3
DO AMMSCNT^SDOQMP1
IF AMMSLAST=0
QUIT
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
BLDPME ; Build the data array to be included in the mail message.
+1 ; If the number of data lines in the current array goes over 100,
+2 ; Send the array and begin building a new one.
+3 ;
+4 ; Data String format:
+5 ; Clinic Name^Date Run^Date of Next Appt.^# of Days^Stop code^Division
+6 ;
+7 NEW X,LC,PMNODE,PMDT,PMMSG,PMCLNI,PMCLNE,PMAPT
+8 ;
+9 KILL ^TMP("SDMSG")
+10 SET X=$GET(^TMP("SDPM",$JOB,0))
SET PMDT=$PIECE(X,U)
+11 SET LC=1
SET PMCLNI=0
+12 ;
+13 FOR
SET PMCLNI=$ORDER(^TMP("SDPM",$JOB,PMCLNI))
IF 'PMCLNI
QUIT
Begin DoDot:1
+14 SET PMNODE=$GET(^TMP("SDPM",$JOB,PMCLNI,PMDT))
+15 SET PMCLNE=$PIECE($GET(^SC(PMCLNI,0)),U)
+16 SET PMAPT=$PIECE(PMNODE,U)
+17 SET X2=PMDT
SET X1=PMAPT
DO ^%DTC
+18 SET ^TMP("SDMSG",$JOB,LC)=PMCLNE_U_PMDT_U_PMAPT_U_$SELECT(X']"":-1,1:X)_U_$$STOPCDE^SDOQMP0(PMCLNI)_U_$$DIVISION^SDOQMP0(PMCLNI)
+19 SET LC=LC+1
End DoDot:1
+20 ;
+21 IF LC>350
DO PRCLRG
+22 IF LC'>350
DO PRCSML
DMQ QUIT
+1 ;
PRCSML ; Process clinic lists smaller than 500 entries
+1 NEW PMMSG,LC
+2 SET (X,LC)=0
+3 FOR
SET X=$ORDER(^TMP("SDMSG",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+4 SET LC=LC+1
+5 SET PMMSG(LC)=^TMP("SDMSG",$JOB,X)
End DoDot:1
+6 DO MAIL(.PMMSG,LC)
+7 QUIT
+8 ;
PRCLRG ; Process clinic lists greater than 500 entries
+1 NEW SDTMP,XF,XL,XC
+2 SET XF=1
SET XL=350
+3 ;
LP1 FOR XC=XF:1:XL
IF XC'<LC
QUIT
Begin DoDot:1
+1 SET SDTMP(XC)=^TMP("SDMSG",$JOB,XC)
End DoDot:1
+2 ;
+3 DO MAIL(.SDTMP,LC,XC)
+4 ;
+5 SET XF=XL+1
SET XL=XL+350
+6 KILL SDTMP
+7 IF XC<LC
GOTO LP1
+8 QUIT
+9 ;
MAIL(PMDATA,LINCNT,CNT) ; Send data message to server.
+1 ; The data message is sent to the local notification mail group,
+2 ; the notification mail group at the server domain, and the
+3 ; server at the data collection server domain
+4 ;
+5 ; Server
+6 ; A1BO PM NEXT APPT EXTRACT at Albany ISC
+7 ;
+8 ; Variables
+9 ; MSG - Data array to be sent
+10 ; LINCNT - Number of lines in the data array
+11 ;
+12 ; Message Format
+13 ; Header - $START^Site Name^Facility Number^Date.Time run^Domain Name^Total lines^Last line sent
+14 ; Body - data array (see BLDPME)
+15 ; Tail - $END
+16 ;
+17 NEW XC,X1,%DT,XMB,PMFAC,XMLOC
+18 ;
+19 SET XMLOC=0
+20 SET XMDUZ=.5
+21 SET XMY(".5")=""
+22 SET XMY("S.A1BO PM NEXT APPT EXTRACT@DEVFEX.ISC-ALBANY.VA.GOV")=""
+23 SET XMY("G.SD PM NOTIFICATION")=""
+24 SET XMY("G.SD PM EXTRACT@ISC-ALBANY.VA.GOV")=""
+25 ;
+26 SET PMFAC=$$SITE^VASITE
+27 DO NOW^%DTC
+28 ;
+29 SET PMDATA(.01)="$START^"_$PIECE($GET(PMFAC),"^",2,3)_"^"_%_"^"_$GET(^XMB("NETNAME"))_"^"_LINCNT_"^"_$GET(CNT)
+30 SET PMDATA(LINCNT+1)="$END"
+31 ;
+32 SET XMTEXT="PMDATA("
+33 SET XMSUB="Access PM Extract from "_$PIECE($GET(PMFAC),U,2)
SET XMN=0
+34 DO ^XMD
+35 KILL XMDUZ,XMN,XMSUB,XMTEXT,XMY
SMQ QUIT
+1 ;
BLDRPT ; Call the entry point to print the Appointment Monitoring report
+1 DO START^SDOQMPR
+2 QUIT
+3 ;
MSG ; Message displayed to user when the EN1 entry point is used.
+1 ;;
+2 ;;This report requires 132 columns and could take a long time
+3 ;;to print depending on the number of clinics selected.
+4 ;;Please remember to QUEUE it.
+5 ;;$$END
