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

SDOQMP.m

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