SDOQMP0 ;ALB/SCK - Appointment Monitoring / Performance Measure Rpt. ; [07/23/96]
;;5.3;SCHEDULING;**47**;AUG 13, 1993
;
Q
SELECT() ; Selection method for clinic selection.
; Returns:
; Y = S, D, or C for Stop Code, Division, or Clinic.
; Y = Null for up-arrow or timeout
;
N Y
S DIR(0)="SM^D:Division;S:Stop Code;C:Clinic"
S DIR("A")="Select clinics by: "
S DIR("?")="Select by either: Stop Code, Division, or Clinic"
S DIR("?",1)="The method by which clinics are selected for this report."
S DIR("B")="S"
D ^DIR K DIR
S:$D(DIRUT) Y=""
SELQ Q $G(Y)
;
CLINIC() ; One-Many-All clinic selection
; Output
; CLINIC(IEN)=""
;
W !!,"Clinic Selection"
S DIC="^SC(",VAUTSTR="Clinic",VAUTVB="CLINIC",VAUTNI=2,DIC("S")="I $P(^(0),U,3)[""C"""
D FIRST^VAUTOMA
I Y<0 K CLINIC
Q $D(CLINIC)>0
;
STOP() ; -- get stop code data
; output: VAUTC := stop codes selected (VAUTC=1 for all)
; return: was selection made [ 1|yes 0|no]
;
W !!,"Stop Code Selection"
S DIC="^DIC(40.7,",VAUTSTR="Stop Code",VAUTVB="VAUTC",VAUTNI=2
D FIRST^VAUTOMA
I Y<0 K VAUTC
STOPQ Q $D(VAUTC)>0
;
DIV() ; -- get division data
; input: none
; output: VAUTD := divs selected (VAUTD=1 for all)
; return: was selection made [ 1|yes 0|no]
;
W:$P($G(^DG(43,1,"GL")),U,2) !!,"Division Selection"
D ASK2^SDDIV
I Y<0 K VAUTD
Q $D(VAUTD)>0
;
STOPCDE(PMIEN) ; Get associated stop code number for clinic
; Input
; PMIEN - Ien of clinic in the Hospital location file
;
; Output
; Either Stop code number, or 0 if no stop code is found
;
N PMSC
S PMSC=+$P($G(^DIC(40.7,$P($G(^SC(PMIEN,0)),U,7),0)),U,2)
Q $S(+PMSC>0:PMSC,1:0)
;
CLNOK(PMSC) ; Checks associated stop code for clinic.
; Input
; PMSC - Associated stop code for current clinic
;
; Output
; PMOK - Returns 1 if stop code is on the list
; Returns 0 if it's not on the list.
;
N PMOK,CNT,PMSTCD
S PMOK=0
F CNT=1:1 S PMSTCD=$P($T(STOPS+CNT^SDOQMPL),";;",2) Q:PMSTCD="$$END" D Q:PMOK
. Q:'$D(^DIC(40.7,PMSC,0))
. I $P($G(^DIC(40.7,PMSC,0)),U,2)=PMSTCD S PMOK=1
Q PMOK
;
DIVISION(PMIEN) ; Returns the name of the division the clinic as assigned to.
; Input:
; Ien of clinic in the Hospital location file.
;
; Output:
; Division name in external format.
;
N PMDIEN,PDIV
S PMDIV=""
S PMDIEN=+$P($G(^SC(PMIEN,0)),U,15)
G:PMDIEN'>0 DIVQ
S PMDIV=$P($G(^DG(40.8,PMDIEN,0)),U)
DIVQ Q PMDIV
;
LOOPSC ; Loops through all clinics in the Hospital location file, and selects clinics that are
; associated with one of the selected stop codes, adding them to the "SDAMMS" TMP global.
; If VAUTC=1, then select clinics for all Stop codes.
; If VAUTC=0, then select only those clinics for the Stop codes in the
; VAUTC(StopCode Ien) local array.
;
N PMSC,AMMSD0
S AMMSD0=0
;
; *** Select all
I VAUTC=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 only clinics with a selected associated stop code
I VAUTC=0&($D(VAUTC)) D
. F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
.. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
.. S PMSC=$P($G(^SC(AMMSD0,0)),"^",7)
.. Q:'$D(VAUTC(PMSC))
.. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
.. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
Q
;
LOOPD ; Loops through all clinics in the Hospital location file, and select clinics that are
; in one of the selected divisions, adding them to the "SDAMMS" TMP global.
; If VAUTD=1, then select clinics for all Divisions.
; If VAUTD=0, then select only those clinics for the Divisions in the
; VAUTC(StopCode Ien) local array.
;
N PMDIV,AMMSD0
;
S AMMSD0=0
; Select all
I VAUTD=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
;
I VAUTD=0&($D(VAUTD)) D
. F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
.. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
.. S PMDIV=$P($G(^SC(AMMSD0,0)),"^",15)
.. Q:PMDIV']""
.. Q:'$D(VAUTD(PMDIV))
.. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
.. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
Q
;
CHKTASK() ; Checks if the expiration date has been reached. If it has, delete the option
; scheduling run time field to turn off the reschedule option
;
N OIEN,OSIEN,PMTEXT,EXPDT,SDOPT,SDWHN,SDFRQ,SDOK
;
S SDOK=0
S EXPDT=$P($T(EXPIRE+1^SDOQMPL),";;",2)
D NOW^%DTC
G:$P(%,".")<EXPDT CHKQ
S OIEN="",OIEN=$O(^DIC(19,"B","SDOQM PM NIGHTLY JOB",OIEN))
Q:OIEN']""
S OSIEN="",OSIEN=$O(^DIC(19.2,"B",OIEN,OSIEN))
Q:OSIEN']""
;
S SDWHN="@",SDFRQ="@",SDOPT="SDOQM PM NIGHTLY JOB"
D RESCH^XUTMOPT(SDOPT,SDWHN,"",SDFRQ,"",.SCERR)
;
S PMTEXT(1)="The Access Performance Measure data collection job"
S PMTEXT(2)="has expired, and the background server has been unscheduled"
S PMTEXT(3)=""
S PMTEXT(4)="The entry in the SCHEDULING OPTION file should be removed"
S PMTEXT(5)="by your IRM staff"
S XMSUB="PM EXTRACT EXPIRATION",XMN=0
S XMTEXT="PMTEXT("
S XMDUZ=.5,XMY("G.SD PM NOTIFICATION")=""
D ^XMD
S SDOK=1
CHKQ Q SDOK
;
LOOPS ; Use appropriate loop for building the clinic global.
;
I $D(CLINIC) D LOOPC^SDOQMP Q
I $D(VAUTC) D LOOPSC Q
I $D(VAUTD) D LOOPD Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDOQMP0 5521 printed Dec 13, 2024@02:59:14 Page 2
SDOQMP0 ;ALB/SCK - Appointment Monitoring / Performance Measure Rpt. ; [07/23/96]
+1 ;;5.3;SCHEDULING;**47**;AUG 13, 1993
+2 ;
+3 QUIT
SELECT() ; Selection method for clinic selection.
+1 ; Returns:
+2 ; Y = S, D, or C for Stop Code, Division, or Clinic.
+3 ; Y = Null for up-arrow or timeout
+4 ;
+5 NEW Y
+6 SET DIR(0)="SM^D:Division;S:Stop Code;C:Clinic"
+7 SET DIR("A")="Select clinics by: "
+8 SET DIR("?")="Select by either: Stop Code, Division, or Clinic"
+9 SET DIR("?",1)="The method by which clinics are selected for this report."
+10 SET DIR("B")="S"
+11 DO ^DIR
KILL DIR
+12 if $DATA(DIRUT)
SET Y=""
SELQ QUIT $GET(Y)
+1 ;
CLINIC() ; One-Many-All clinic selection
+1 ; Output
+2 ; CLINIC(IEN)=""
+3 ;
+4 WRITE !!,"Clinic Selection"
+5 SET DIC="^SC("
SET VAUTSTR="Clinic"
SET VAUTVB="CLINIC"
SET VAUTNI=2
SET DIC("S")="I $P(^(0),U,3)[""C"""
+6 DO FIRST^VAUTOMA
+7 IF Y<0
KILL CLINIC
+8 QUIT $DATA(CLINIC)>0
+9 ;
STOP() ; -- get stop code data
+1 ; output: VAUTC := stop codes selected (VAUTC=1 for all)
+2 ; return: was selection made [ 1|yes 0|no]
+3 ;
+4 WRITE !!,"Stop Code Selection"
+5 SET DIC="^DIC(40.7,"
SET VAUTSTR="Stop Code"
SET VAUTVB="VAUTC"
SET VAUTNI=2
+6 DO FIRST^VAUTOMA
+7 IF Y<0
KILL VAUTC
STOPQ QUIT $DATA(VAUTC)>0
+1 ;
DIV() ; -- get division data
+1 ; input: none
+2 ; output: VAUTD := divs selected (VAUTD=1 for all)
+3 ; return: was selection made [ 1|yes 0|no]
+4 ;
+5 if $PIECE($GET(^DG(43,1,"GL")),U,2)
WRITE !!,"Division Selection"
+6 DO ASK2^SDDIV
+7 IF Y<0
KILL VAUTD
+8 QUIT $DATA(VAUTD)>0
+9 ;
STOPCDE(PMIEN) ; Get associated stop code number for clinic
+1 ; Input
+2 ; PMIEN - Ien of clinic in the Hospital location file
+3 ;
+4 ; Output
+5 ; Either Stop code number, or 0 if no stop code is found
+6 ;
+7 NEW PMSC
+8 SET PMSC=+$PIECE($GET(^DIC(40.7,$PIECE($GET(^SC(PMIEN,0)),U,7),0)),U,2)
+9 QUIT $SELECT(+PMSC>0:PMSC,1:0)
+10 ;
CLNOK(PMSC) ; Checks associated stop code for clinic.
+1 ; Input
+2 ; PMSC - Associated stop code for current clinic
+3 ;
+4 ; Output
+5 ; PMOK - Returns 1 if stop code is on the list
+6 ; Returns 0 if it's not on the list.
+7 ;
+8 NEW PMOK,CNT,PMSTCD
+9 SET PMOK=0
+10 FOR CNT=1:1
SET PMSTCD=$PIECE($TEXT(STOPS+CNT^SDOQMPL),";;",2)
if PMSTCD="$$END"
QUIT
Begin DoDot:1
+11 if '$DATA(^DIC(40.7,PMSC,0))
QUIT
+12 IF $PIECE($GET(^DIC(40.7,PMSC,0)),U,2)=PMSTCD
SET PMOK=1
End DoDot:1
if PMOK
QUIT
+13 QUIT PMOK
+14 ;
DIVISION(PMIEN) ; Returns the name of the division the clinic as assigned to.
+1 ; Input:
+2 ; Ien of clinic in the Hospital location file.
+3 ;
+4 ; Output:
+5 ; Division name in external format.
+6 ;
+7 NEW PMDIEN,PDIV
+8 SET PMDIV=""
+9 SET PMDIEN=+$PIECE($GET(^SC(PMIEN,0)),U,15)
+10 if PMDIEN'>0
GOTO DIVQ
+11 SET PMDIV=$PIECE($GET(^DG(40.8,PMDIEN,0)),U)
DIVQ QUIT PMDIV
+1 ;
LOOPSC ; Loops through all clinics in the Hospital location file, and selects clinics that are
+1 ; associated with one of the selected stop codes, adding them to the "SDAMMS" TMP global.
+2 ; If VAUTC=1, then select clinics for all Stop codes.
+3 ; If VAUTC=0, then select only those clinics for the Stop codes in the
+4 ; VAUTC(StopCode Ien) local array.
+5 ;
+6 NEW PMSC,AMMSD0
+7 SET AMMSD0=0
+8 ;
+9 ; *** Select all
+10 IF VAUTC=1
Begin DoDot:1
+11 FOR
SET AMMSD0=$ORDER(^SC("AC","C",AMMSD0))
if 'AMMSD0
QUIT
Begin DoDot:2
+12 if '$PIECE($GET(^SC(AMMSD0,0)),"^",7)
QUIT
+13 if $GET(^TMP("SDAMMS",$JOB,"Q"))=1
QUIT
+14 FOR X1=1:1:3
DO AMMSCNT^SDOQMP1
if AMMSLAST=0
QUIT
End DoDot:2
End DoDot:1
+15 ;
+16 ; *** Select only clinics with a selected associated stop code
+17 IF VAUTC=0&($DATA(VAUTC))
Begin DoDot:1
+18 FOR
SET AMMSD0=$ORDER(^SC("AC","C",AMMSD0))
if 'AMMSD0
QUIT
Begin DoDot:2
+19 if '$PIECE($GET(^SC(AMMSD0,0)),"^",7)
QUIT
+20 SET PMSC=$PIECE($GET(^SC(AMMSD0,0)),"^",7)
+21 if '$DATA(VAUTC(PMSC))
QUIT
+22 if $GET(^TMP("SDAMMS",$JOB,"Q"))=1
QUIT
+23 FOR X1=1:1:3
DO AMMSCNT^SDOQMP1
if AMMSLAST=0
QUIT
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
LOOPD ; Loops through all clinics in the Hospital location file, and select clinics that are
+1 ; in one of the selected divisions, adding them to the "SDAMMS" TMP global.
+2 ; If VAUTD=1, then select clinics for all Divisions.
+3 ; If VAUTD=0, then select only those clinics for the Divisions in the
+4 ; VAUTC(StopCode Ien) local array.
+5 ;
+6 NEW PMDIV,AMMSD0
+7 ;
+8 SET AMMSD0=0
+9 ; Select all
+10 IF VAUTD=1
Begin DoDot:1
+11 FOR
SET AMMSD0=$ORDER(^SC("AC","C",AMMSD0))
if 'AMMSD0
QUIT
Begin DoDot:2
+12 if '$PIECE($GET(^SC(AMMSD0,0)),"^",7)
QUIT
+13 if $GET(^TMP("SDAMMS",$JOB,"Q"))=1
QUIT
+14 FOR X1=1:1:3
DO AMMSCNT^SDOQMP1
if AMMSLAST=0
QUIT
End DoDot:2
End DoDot:1
+15 ;
+16 IF VAUTD=0&($DATA(VAUTD))
Begin DoDot:1
+17 FOR
SET AMMSD0=$ORDER(^SC("AC","C",AMMSD0))
if 'AMMSD0
QUIT
Begin DoDot:2
+18 if '$PIECE($GET(^SC(AMMSD0,0)),"^",7)
QUIT
+19 SET PMDIV=$PIECE($GET(^SC(AMMSD0,0)),"^",15)
+20 if PMDIV']""
QUIT
+21 if '$DATA(VAUTD(PMDIV))
QUIT
+22 if $GET(^TMP("SDAMMS",$JOB,"Q"))=1
QUIT
+23 FOR X1=1:1:3
DO AMMSCNT^SDOQMP1
if AMMSLAST=0
QUIT
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
CHKTASK() ; Checks if the expiration date has been reached. If it has, delete the option
+1 ; scheduling run time field to turn off the reschedule option
+2 ;
+3 NEW OIEN,OSIEN,PMTEXT,EXPDT,SDOPT,SDWHN,SDFRQ,SDOK
+4 ;
+5 SET SDOK=0
+6 SET EXPDT=$PIECE($TEXT(EXPIRE+1^SDOQMPL),";;",2)
+7 DO NOW^%DTC
+8 if $PIECE(%,".")<EXPDT
GOTO CHKQ
+9 SET OIEN=""
SET OIEN=$ORDER(^DIC(19,"B","SDOQM PM NIGHTLY JOB",OIEN))
+10 if OIEN']""
QUIT
+11 SET OSIEN=""
SET OSIEN=$ORDER(^DIC(19.2,"B",OIEN,OSIEN))
+12 if OSIEN']""
QUIT
+13 ;
+14 SET SDWHN="@"
SET SDFRQ="@"
SET SDOPT="SDOQM PM NIGHTLY JOB"
+15 DO RESCH^XUTMOPT(SDOPT,SDWHN,"",SDFRQ,"",.SCERR)
+16 ;
+17 SET PMTEXT(1)="The Access Performance Measure data collection job"
+18 SET PMTEXT(2)="has expired, and the background server has been unscheduled"
+19 SET PMTEXT(3)=""
+20 SET PMTEXT(4)="The entry in the SCHEDULING OPTION file should be removed"
+21 SET PMTEXT(5)="by your IRM staff"
+22 SET XMSUB="PM EXTRACT EXPIRATION"
SET XMN=0
+23 SET XMTEXT="PMTEXT("
+24 SET XMDUZ=.5
SET XMY("G.SD PM NOTIFICATION")=""
+25 DO ^XMD
+26 SET SDOK=1
CHKQ QUIT SDOK
+1 ;
LOOPS ; Use appropriate loop for building the clinic global.
+1 ;
+2 IF $DATA(CLINIC)
DO LOOPC^SDOQMP
QUIT
+3 IF $DATA(VAUTC)
DO LOOPSC
QUIT
+4 IF $DATA(VAUTD)
DO LOOPD
QUIT
+5 QUIT
