RAPM4.m

RAPM4 ;HOIFO/TH-Radiology Performance Monitors/Indicator; ;8/05/05  14:06

 ;;5.0;Radiology/Nuclear Medicine;**63**;Mar 16, 1998

CKMONTH ; If requested an entire month's data, ask if output goes to OQP

 N RAM,RAMINT

 S RAM=$E(RABDATE,4,5)

 Q:RAM'=$E(RAEDATE,4,5)  ;diff months

 ; find min total days for the requested month

 S RAMINT=31 S:RAM="02" RAMINT=28 I "04^06^09^11"[RAM S RAMINT=30

 S X1=RAEDATE,X2=RABDATE D ^%DTC

 I (X+1)'<RAMINT D HQASK

 Q

HQASK ;

 N DIR

 S DIR("A",1)=" "

 S:'$D(RALASTM) DIR("A",2)="  You have requested an entire month's data."

 S DIR("A",3)="  Do you want to include the OQP Performance Management staff"

 S DIR("A")="  as a recipient of this output"

 S DIR(0)="Y",DIR("B")="NO"

 S DIR("?",1)="   Normally, the OQP Performance Management (Headquarters) only receive"

 S DIR("?",2)="   the automatic mid-month report.  However, if they missed the report"

 S DIR("?",3)="   for the month specified above, and you want them to receive it,"

 S DIR("?")="   answer ""Y""."

 D ^DIR I Y S RAUTOM=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RAPM4   1048     printed  Apr 09, 2024@21:35:06                                                                                                                                                                                                       Page 2

RAPM4     ;HOIFO/TH-Radiology Performance Monitors/Indicator; ;8/05/05  14:06

 +1       ;;5.0;Radiology/Nuclear Medicine;**63**;Mar 16, 1998

CKMONTH   ; If requested an entire month's data, ask if output goes to OQP

 +1        NEW RAM,RAMINT

 +2        SET RAM=$EXTRACT(RABDATE,4,5)

 +3       ;diff months

           if RAM'=$EXTRACT(RAEDATE,4,5)

               QUIT 

 +4       ; find min total days for the requested month

 +5        SET RAMINT=31

           if RAM="02"

               SET RAMINT=28

           IF "04^06^09^11"[RAM

               SET RAMINT=30

 +6        SET X1=RAEDATE

           SET X2=RABDATE

           DO ^%DTC

 +7        IF (X+1)'<RAMINT

               DO HQASK

 +8        QUIT 

HQASK     ;

 +1        NEW DIR

 +2        SET DIR("A",1)=" "

 +3        if '$DATA(RALASTM)

               SET DIR("A",2)="  You have requested an entire month's data."

 +4        SET DIR("A",3)="  Do you want to include the OQP Performance Management staff"

 +5        SET DIR("A")="  as a recipient of this output"

 +6        SET DIR(0)="Y"

           SET DIR("B")="NO"

 +7        SET DIR("?",1)="   Normally, the OQP Performance Management (Headquarters) only receive"

 +8        SET DIR("?",2)="   the automatic mid-month report.  However, if they missed the report"

 +9        SET DIR("?",3)="   for the month specified above, and you want them to receive it,"

 +10       SET DIR("?")="   answer ""Y""."

 +11       DO ^DIR

           IF Y

               SET RAUTOM=1

 +12       QUIT