[613] | 1 | SDOQMP ;ALB/SCK - Appointment Monitoring / Performance Measure report ; [07/17/96]
|
---|
| 2 | ;;5.3;SCHEDULING;**47**;AUG 13,1993
|
---|
| 3 | Q
|
---|
| 4 | ;
|
---|
| 5 | EN ; Entry point for Access PM extract to be sent to data collection server
|
---|
| 6 | ;
|
---|
| 7 | Q:$$CHKTASK^SDOQMP0
|
---|
| 8 | D INIT,LOOP,START^SDOQMP2,BLDPME
|
---|
| 9 | D END^SDOQMP1
|
---|
| 10 | Q
|
---|
| 11 | ;
|
---|
| 12 | EN1 ; Entry point for interactive appointment monitoring report
|
---|
| 13 | ;
|
---|
| 14 | N XT,XT1,CONT,PMSEL
|
---|
| 15 | ;
|
---|
| 16 | S PMSEL=$$SELECT^SDOQMP0
|
---|
| 17 | Q:PMSEL']""
|
---|
| 18 | ;
|
---|
| 19 | I PMSEL="C" G EN1Q:'$$CLINIC^SDOQMP0
|
---|
| 20 | I PMSEL="S" G EN1Q:'$$STOP^SDOQMP0
|
---|
| 21 | I PMSEL="D" G EN1Q:'$$DIV^SDOQMP0
|
---|
| 22 | ;
|
---|
| 23 | F XT=1:1 S XT1=$P($T(MSG+XT),";;",2) Q:XT1="$$END" W !,XT1
|
---|
| 24 | AGN S CONT=0
|
---|
| 25 | S %ZIS="Q" D ^%ZIS G:POP EN1Q
|
---|
| 26 | ;
|
---|
| 27 | I IOM'=132 D G:'CONT AGN
|
---|
| 28 | . S:$E(IOST,1,2)="C-" DIR("A",1)="It's not recommended to print this report to screen."
|
---|
| 29 | . S DIR(0)="Y^A",DIR("A")="Do you want to select another device?",DIR("B")="YES"
|
---|
| 30 | . S DIR("A",2)="The selected device does not have 132 columns."
|
---|
| 31 | . D ^DIR K DIR
|
---|
| 32 | . S:$D(DIRUT)!(Y=0) CONT=1
|
---|
| 33 | ;
|
---|
| 34 | QUE I $D(IO("Q")) D G EN1Q
|
---|
| 35 | . S ZTRTN="START^SDOQMP",ZTDESC="Appointment Monitoring Report"
|
---|
| 36 | . S:PMSEL="C" ZTSAVE("CLINIC(")="",ZTSAVE("CLINIC")=""
|
---|
| 37 | . S:PMSEL="S" ZTSAVE("VAUTC(")="",ZTSAVE("VAUTC")=""
|
---|
| 38 | . S:PMSEL="D" ZTSAVE("VAUTD(")="",ZTSAVE("VAUTD")=""
|
---|
| 39 | . D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
|
---|
| 40 | . D HOME^%ZIS K IO("Q")
|
---|
| 41 | ;
|
---|
| 42 | D WAIT^DICD
|
---|
| 43 | START D INIT,LOOPS^SDOQMP0,START^SDOQMP2,BLDRPT
|
---|
| 44 | ;
|
---|
| 45 | EN1Q D:'$D(ZTQUEUED) ^%ZISC
|
---|
| 46 | D END^SDOQMP1
|
---|
| 47 | K CLINIC,^TMP("SDAMMS"),^TMP("SDPM"),VAUTD,VAUTC,^TMP("SDMSG")
|
---|
| 48 | Q
|
---|
| 49 | ;
|
---|
| 50 | INIT ; Initialize date arrays for calculating next available appointments
|
---|
| 51 | ;
|
---|
| 52 | S:'$D(U) U="^"
|
---|
| 53 | K ^TMP("SDAMMS"),^TMP("SDPM"),^TMP("APPT")
|
---|
| 54 | S ^TMP("SDAMMS",$J,"MGN")=80,(CNT,CNT1,CNT2,CNT3,CNT4)=0,IOM=80
|
---|
| 55 | S ^TMP("SDAMMS",$J,"PG")=0,$P(^TMP("SDAMMS",$J,"="),"=",IOM)=""
|
---|
| 56 | S X="T" D ^%DT S DT=Y X ^DD("DD") S ^TMP("SDAMMS",$J,"DT")=Y
|
---|
| 57 | S X="T" D ^%DT S AMMSRDT=Y
|
---|
| 58 | S ^TMP("SDPM",$J,0)=DT
|
---|
| 59 | S AMMSCNT="",AMMSLAST=0,AMMSZDT=DT,AMMSFDT=20,AMMSFSL=33
|
---|
| 60 | D DATES^SDOQMP1
|
---|
| 61 | Q
|
---|
| 62 | ;
|
---|
| 63 | LOOP ; Loop through the clinics in the Hospital location file. Use only those clinics with
|
---|
| 64 | ; an associated stop code on the required list for the access performance measure
|
---|
| 65 | ;
|
---|
| 66 | ; Variables
|
---|
| 67 | ; AMMSD0 - Clinic IEN
|
---|
| 68 | ;
|
---|
| 69 | S AMMSD0=0
|
---|
| 70 | F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
|
---|
| 71 | . Q:'$P($G(^SC(AMMSD0,0)),"^",7)
|
---|
| 72 | . Q:'$$CLNOK^SDOQMP0($P($G(^SC(AMMSD0,0)),"^",7))
|
---|
| 73 | . Q:$G(^TMP("SDAMMS",$J,"Q"))=1
|
---|
| 74 | . F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | LOOPC ; Loop through the clinics in the hospital location file. User can select
|
---|
| 78 | ; one-many-all clinics through this entry point.
|
---|
| 79 | ;
|
---|
| 80 | ; Variables
|
---|
| 81 | ; AMMSD0 - Clinic IEN
|
---|
| 82 | ; CLINIC - Clinic array returned from VAUTOMA
|
---|
| 83 | ;
|
---|
| 84 | S AMMSD0=0
|
---|
| 85 | ; Select all
|
---|
| 86 | I CLINIC=1 D
|
---|
| 87 | . F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
|
---|
| 88 | .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
|
---|
| 89 | .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
|
---|
| 90 | .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
|
---|
| 91 | ;
|
---|
| 92 | ; Select One-Many
|
---|
| 93 | I CLINIC=0&($D(CLINIC)) D
|
---|
| 94 | . F S AMMSD0=$O(CLINIC(AMMSD0)) Q:'AMMSD0 D
|
---|
| 95 | .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
|
---|
| 96 | .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
|
---|
| 97 | .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
|
---|
| 98 | Q
|
---|
| 99 | ;
|
---|
| 100 | BLDPME ; Build the data array to be included in the mail message.
|
---|
| 101 | ; If the number of data lines in the current array goes over 100,
|
---|
| 102 | ; Send the array and begin building a new one.
|
---|
| 103 | ;
|
---|
| 104 | ; Data String format:
|
---|
| 105 | ; Clinic Name^Date Run^Date of Next Appt.^# of Days^Stop code^Division
|
---|
| 106 | ;
|
---|
| 107 | N X,LC,PMNODE,PMDT,PMMSG,PMCLNI,PMCLNE,PMAPT
|
---|
| 108 | ;
|
---|
| 109 | K ^TMP("SDMSG")
|
---|
| 110 | S X=$G(^TMP("SDPM",$J,0)),PMDT=$P(X,U)
|
---|
| 111 | S LC=1,PMCLNI=0
|
---|
| 112 | ;
|
---|
| 113 | F S PMCLNI=$O(^TMP("SDPM",$J,PMCLNI)) Q:'PMCLNI D
|
---|
| 114 | . S PMNODE=$G(^TMP("SDPM",$J,PMCLNI,PMDT))
|
---|
| 115 | . S PMCLNE=$P($G(^SC(PMCLNI,0)),U)
|
---|
| 116 | . S PMAPT=$P(PMNODE,U)
|
---|
| 117 | . S X2=PMDT,X1=PMAPT D ^%DTC
|
---|
| 118 | . S ^TMP("SDMSG",$J,LC)=PMCLNE_U_PMDT_U_PMAPT_U_$S(X']"":-1,1:X)_U_$$STOPCDE^SDOQMP0(PMCLNI)_U_$$DIVISION^SDOQMP0(PMCLNI)
|
---|
| 119 | . S LC=LC+1
|
---|
| 120 | ;
|
---|
| 121 | D:LC>350 PRCLRG
|
---|
| 122 | I LC'>350 D PRCSML
|
---|
| 123 | DMQ Q
|
---|
| 124 | ;
|
---|
| 125 | PRCSML ; Process clinic lists smaller than 500 entries
|
---|
| 126 | N PMMSG,LC
|
---|
| 127 | S (X,LC)=0
|
---|
| 128 | F S X=$O(^TMP("SDMSG",$J,X)) Q:'X D
|
---|
| 129 | . S LC=LC+1
|
---|
| 130 | . S PMMSG(LC)=^TMP("SDMSG",$J,X)
|
---|
| 131 | D MAIL(.PMMSG,LC)
|
---|
| 132 | Q
|
---|
| 133 | ;
|
---|
| 134 | PRCLRG ; Process clinic lists greater than 500 entries
|
---|
| 135 | N SDTMP,XF,XL,XC
|
---|
| 136 | S XF=1,XL=350
|
---|
| 137 | ;
|
---|
| 138 | LP1 F XC=XF:1:XL Q:XC'<LC D
|
---|
| 139 | . S SDTMP(XC)=^TMP("SDMSG",$J,XC)
|
---|
| 140 | ;
|
---|
| 141 | D MAIL(.SDTMP,LC,XC)
|
---|
| 142 | ;
|
---|
| 143 | S XF=XL+1,XL=XL+350
|
---|
| 144 | K SDTMP
|
---|
| 145 | G:XC<LC LP1
|
---|
| 146 | Q
|
---|
| 147 | ;
|
---|
| 148 | MAIL(PMDATA,LINCNT,CNT) ; Send data message to server.
|
---|
| 149 | ; The data message is sent to the local notification mail group,
|
---|
| 150 | ; the notification mail group at the server domain, and the
|
---|
| 151 | ; server at the data collection server domain
|
---|
| 152 | ;
|
---|
| 153 | ; Server
|
---|
| 154 | ; A1BO PM NEXT APPT EXTRACT at Albany ISC
|
---|
| 155 | ;
|
---|
| 156 | ; Variables
|
---|
| 157 | ; MSG - Data array to be sent
|
---|
| 158 | ; LINCNT - Number of lines in the data array
|
---|
| 159 | ;
|
---|
| 160 | ; Message Format
|
---|
| 161 | ; Header - $START^Site Name^Facility Number^Date.Time run^Domain Name^Total lines^Last line sent
|
---|
| 162 | ; Body - data array (see BLDPME)
|
---|
| 163 | ; Tail - $END
|
---|
| 164 | ;
|
---|
| 165 | N XC,X1,%DT,XMB,PMFAC,XMLOC
|
---|
| 166 | ;
|
---|
| 167 | S XMLOC=0
|
---|
| 168 | S XMDUZ=.5
|
---|
| 169 | S XMY(".5")=""
|
---|
| 170 | S XMY("S.A1BO PM NEXT APPT EXTRACT@DEVFEX.ISC-ALBANY.VA.GOV")=""
|
---|
| 171 | S XMY("G.SD PM NOTIFICATION")=""
|
---|
| 172 | S XMY("G.SD PM EXTRACT@ISC-ALBANY.VA.GOV")=""
|
---|
| 173 | ;
|
---|
| 174 | S PMFAC=$$SITE^VASITE
|
---|
| 175 | D NOW^%DTC
|
---|
| 176 | ;
|
---|
| 177 | S PMDATA(.01)="$START^"_$P($G(PMFAC),"^",2,3)_"^"_%_"^"_$G(^XMB("NETNAME"))_"^"_LINCNT_"^"_$G(CNT)
|
---|
| 178 | S PMDATA(LINCNT+1)="$END"
|
---|
| 179 | ;
|
---|
| 180 | S XMTEXT="PMDATA("
|
---|
| 181 | S XMSUB="Access PM Extract from "_$P($G(PMFAC),U,2),XMN=0
|
---|
| 182 | D ^XMD
|
---|
| 183 | K XMDUZ,XMN,XMSUB,XMTEXT,XMY
|
---|
| 184 | SMQ Q
|
---|
| 185 | ;
|
---|
| 186 | BLDRPT ; Call the entry point to print the Appointment Monitoring report
|
---|
| 187 | D START^SDOQMPR
|
---|
| 188 | Q
|
---|
| 189 | ;
|
---|
| 190 | MSG ; Message displayed to user when the EN1 entry point is used.
|
---|
| 191 | ;;
|
---|
| 192 | ;;This report requires 132 columns and could take a long time
|
---|
| 193 | ;;to print depending on the number of clinics selected.
|
---|
| 194 | ;;Please remember to QUEUE it.
|
---|
| 195 | ;;$$END
|
---|