Routine: SCRPW52

SCRPW52 ;RENO/KEITH - Encounters by DSS Identifier/DSS ID by Frequency (OP0, OP1, OP2) (cont.) ; 15 Jul 98  02:38PM

 ;;5.3;Scheduling;**144,466**;AUG 13, 1993;Build 2

 S SDTIT(1)="<*>  DSS ID BY FREQUENCY "_$S(SDSTA=8:"(IP2)",1:"(OP2)")_"  <*>" F SDI=0:1:7 S SDRTOT(SDI)=0

 S SDPAGE=1 D HDR,HD1 Q:SDOUT  S SDSC=0 F  S SDSC=$O(^TMP("SCRPW",$J,SDIV,SDSC)) Q:'SDSC!SDOUT  D PLINE

 Q:SDOUT  W !?14 F SDI=1:1:103 W "="

 S SDRTOT(3)=+$G(^TMP("SCRPW",$J,SDIV,"M","UNI")),SDRTOT(5)=+$G(^TMP("SCRPW",$J,SDIV,"F","UNI")),SDRTOT(7)=SDRTOT(3)+SDRTOT(5),SDRTOT(6)=SDRTOT(0)

 S SDRTOT(2)=+$G(^TMP("SCRPW",$J,SDIV,"M","ENC")),SDRTOT(4)=+$G(^TMP("SCRPW",$J,SDIV,"F","ENC"))

 W !?14,"TOTAL:" F SDI=0:1:7 W ?(23+(12*SDI)),$J(SDRTOT(SDI),10,0)

PLINE ;Print output line

 K SDCT S SDCT(0)=+$G(^TMP("SCRPW",$J,SDIV,SDSC,"P","ENC"))

 S SDCT(1)=+$G(^TMP("SCRPW",$J,SDIV,SDSC,"S","ENC"))

 S SDCT(2)=+$G(^TMP("SCRPW",$J,SDIV,SDSC,"SEX","M"))

 S SDCT(3)=+$G(^TMP("SCRPW",$J,SDIV,SDSC,"SEX","M","UNI"))

 S SDCT(4)=+$G(^TMP("SCRPW",$J,SDIV,SDSC,"SEX","F"))

 S SDCT(5)=+$G(^TMP("SCRPW",$J,SDIV,SDSC,"SEX","F","UNI"))

 S SDCT(6)=SDCT(0)+SDCT(1),SDCT(7)=SDCT(3)+SDCT(5)

 F SDI=0,1 S SDRTOT(SDI)=SDRTOT(SDI)+SDCT(SDI)

 D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT

 W !?16,SDSC F SDI=0:1:7 W ?(23+(12*SDI)),$J(SDCT(SDI),10,0)

HDR D HDR^SCRPW51 Q

HD1 ;Print subheader

 Q:SDOUT  W !?24,"FREQUENCY",?36,"FREQUENCY",?51,"# MALE",?63,"# MALE",?73,"# FEMALE",?85,"# FEMALE",?100,"TOTAL",?112,"TOTAL"

 W !?14,"DSS ID",?23,"AS PRIMARY",?36,"AS CREDIT",?47,"ENCOUNTERS",?62,"UNIQUES",?71,"ENCOUNTERS",?86,"UNIQUES",?95,"ENCOUNTERS",?110,"UNIQUES"

 W !?14,"-------" F SDI=0:1:7 W ?(23+(12*SDI)),$E(SDLINE,1,10)

EXIT I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR

 K ^TMP("SCRPW",$J),%,%I,%H,DFN,DIR,SD,SDC,SDCT,SDDIV,SDFY,SDGTOT,SDI,SDIV,SDIVN,SDLINE,SDM1,SDMD,SDMF,SDMO,SDOE,SDOE0,SDOUT,SDPAGE,SDPG

 K SDPNOW,SDPS,SDPSC,SDRTOT,SDSC,SDSCN,SDSSC,SDSTOP,SDT,SDTCT,SDTIT,SDUNI,SDIV,SDVCT,SDX,SDYMO,X,Y,SDSTA Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW52   2004     printed  Apr 09, 2024@22:05:12                                                                                                                                                                                                     Page 2

SCRPW52   ;RENO/KEITH - Encounters by DSS Identifier/DSS ID by Frequency (OP0, OP1, OP2) (cont.) ; 15 Jul 98  02:38PM

 +1       ;;5.3;Scheduling;**144,466**;AUG 13, 1993;Build 2

 +2        SET SDTIT(1)="<*>  DSS ID BY FREQUENCY "_$SELECT(SDSTA=8:"(IP2)",1:"(OP2)")_"  <*>"

           FOR SDI=0:1:7

               SET SDRTOT(SDI)=0

 +3        SET SDPAGE=1

           DO HDR

           DO HD1

           if SDOUT

               QUIT

           SET SDSC=0

FOR

               SET SDSC=$ORDER(^TMP("SCRPW",$JOB,SDIV,SDSC))

               if 'SDSC!SDOUT

                   QUIT

               DO PLINE

 +4        if SDOUT

               QUIT

           WRITE !?14

           FOR SDI=1:1:103

               WRITE "="

 +5        SET SDRTOT(3)=+$GET(^TMP("SCRPW",$JOB,SDIV,"M","UNI"))

           SET SDRTOT(5)=+$GET(^TMP("SCRPW",$JOB,SDIV,"F","UNI"))

           SET SDRTOT(7)=SDRTOT(3)+SDRTOT(5)

           SET SDRTOT(6)=SDRTOT(0)

 +6        SET SDRTOT(2)=+$GET(^TMP("SCRPW",$JOB,SDIV,"M","ENC"))

           SET SDRTOT(4)=+$GET(^TMP("SCRPW",$JOB,SDIV,"F","ENC"))

 +7        WRITE !?14,"TOTAL:"

           FOR SDI=0:1:7

               WRITE ?(23+(12*SDI)),$JUSTIFY(SDRTOT(SDI),10,0)

 +8        QUIT

 +9       ;

PLINE     ;Print output line

 +1        KILL SDCT

           SET SDCT(0)=+$GET(^TMP("SCRPW",$JOB,SDIV,SDSC,"P","ENC"))

 +2        SET SDCT(1)=+$GET(^TMP("SCRPW",$JOB,SDIV,SDSC,"S","ENC"))

 +3        SET SDCT(2)=+$GET(^TMP("SCRPW",$JOB,SDIV,SDSC,"SEX","M"))

 +4        SET SDCT(3)=+$GET(^TMP("SCRPW",$JOB,SDIV,SDSC,"SEX","M","UNI"))

 +5        SET SDCT(4)=+$GET(^TMP("SCRPW",$JOB,SDIV,SDSC,"SEX","F"))

 +6        SET SDCT(5)=+$GET(^TMP("SCRPW",$JOB,SDIV,SDSC,"SEX","F","UNI"))

 +7        SET SDCT(6)=SDCT(0)+SDCT(1)

           SET SDCT(7)=SDCT(3)+SDCT(5)

 +8        FOR SDI=0,1

               SET SDRTOT(SDI)=SDRTOT(SDI)+SDCT(SDI)

 +9        if $Y>(IOSL-4)

               DO HDR

               DO HD1

           if SDOUT

               QUIT

 +10       WRITE !?16,SDSC

           FOR SDI=0:1:7

               WRITE ?(23+(12*SDI)),$JUSTIFY(SDCT(SDI),10,0)

 +11       QUIT

 +12      ;

HDR        DO HDR^SCRPW51

           QUIT

 +1       ;

HD1       ;Print subheader

 +1        if SDOUT

               QUIT

           WRITE !?24,"FREQUENCY",?36,"FREQUENCY",?51,"# MALE",?63,"# MALE",?73,"# FEMALE",?85,"# FEMALE",?100,"TOTAL",?112,"TOTAL"

 +2        WRITE !?14,"DSS ID",?23,"AS PRIMARY",?36,"AS CREDIT",?47,"ENCOUNTERS",?62,"UNIQUES",?71,"ENCOUNTERS",?86,"UNIQUES",?95,"ENCOUNTERS",?110,"UNIQUES"

 +3        WRITE !?14,"-------"

           FOR SDI=0:1:7

               WRITE ?(23+(12*SDI)),$EXTRACT(SDLINE,1,10)

 +4        QUIT

 +5       ;

EXIT       IF $EXTRACT(IOST)="C"

               IF 'SDOUT

                   NEW DIR

                   SET DIR(0)="E"

                   DO ^DIR

 +1        KILL ^TMP("SCRPW",$JOB),%,%I,%H,DFN,DIR,SD,SDC,SDCT,SDDIV,SDFY,SDGTOT,SDI,SDIV,SDIVN,SDLINE,SDM1,SDMD,SDMF,SDMO,SDOE,SDOE0,SDOUT,SDPAGE,SDPG

 +2        KILL SDPNOW,SDPS,SDPSC,SDRTOT,SDSC,SDSCN,SDSSC,SDSTOP,SDT,SDTCT,SDTIT,SDUNI,SDIV,SDVCT,SDX,SDYMO,X,Y,SDSTA

           QUIT

SCRPW52.m