- 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,1015**;AUG 13, 1993;Build 21
- 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)
- Q
- ;
- 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)
- Q
- ;
- 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)
- Q
- ;
- 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
- 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,1015**;AUG 13, 1993;Build 21
- +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
