PXRMGECM ;SLC/JVS GEC-Score Reports-cont'd ;7/14/05  10:43
 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 Q
SUM ;By Summary by Patient
 N CAT,HF,DATE,DFN,Y,HFN,CNTREF,X,REFNUM,SUM,GSUM,CATDANA,PAGE
 N DATER,SDATE,SCNT
 D E^PXRMGECV("HS1",1,BDT,EDT,"F",DFNONLY)
 I FORMAT="D" S FOR=0
 I FORMAT="F" S FOR=1
 W @IOF
 S CATDANA("GEC REFERRAL BASIC ADL")=""
 S CATDANA("GEC REFERRAL IADL")=""
 S CATDANA("GEC REFERRAL SKILLED CARE")=""
 S CATDANA("GEC REFERRAL PATIENT BEHAVIORS/SYMPTOM")=""
 ;
 S Y=1,SUM=0,DATER=0,GSUM=0
 S DFN="" F  S DFN=$O(^TMP("PXRMGEC",$J,"HS1",DFN)) Q:DFN=""!(Y=0)  D
 .S CNTREF="",REFNUM=0 F  S CNTREF=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF)) Q:CNTREF=""!(Y=0)  D
 ..S REFNUM=REFNUM+1
 ..S SDATE=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,0)) D
 ...S DATER=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,SDATE,0))
 ..S DATE=0 F  S DATE=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE)) Q:DATE=""!(Y=0)  D
 ...S VDT=0 F  S VDT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT)) Q:VDT=""!(Y=0)  D
 ....S CAT=0 F  S CAT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT)) Q:CAT=""!(Y=0)  D
 .....Q:'$D(CATDANA(CAT))
 .....S SUM=0
 .....S DATEV=0 F  S DATEV=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV)) Q:DATEV=""!(Y=0)  D
 ......S DA=0 F  S DA=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV,DA)) Q:DA=""!(Y=0)  D
 .......S HFN=$$HFNAME^PXRMGECR(DA)
 .......S SUM=SUM+$$VALUE($P($G(^AUPNVHF(DA,0)),"^",1))
 .......S CATSUM(CAT)=SUM
 ..S GSUM=+$G(CATSUM("GEC REFERRAL IADL"))+(+$G(CATSUM("GEC REFERRAL BASIC ADL")))+(+$G(CATSUM("GEC REFERRAL SKILLED CARE")))+(+$G(CATSUM("GEC REFERRAL PATIENT BEHAVIORS/SYMPTOM")))
 ..S ^TMP("PXRMGEC",$J,"S",DFN,SDATE,DATER,+$G(CATSUM("GEC REFERRAL IADL")),+$G(CATSUM("GEC REFERRAL BASIC ADL")),+$G(CATSUM("GEC REFERRAL SKILLED CARE")),+$G(CATSUM("GEC REFERRAL PATIENT BEHAVIORS/SYMPTOM")),GSUM)=""
 ..K CATSUM
 ;
DIS ;Start of Display
 S REF="^TMP(""PXRMGEC"",$J,""S"")"
 W !,"=============================================================================="
 W !,"GEC Patient-Summary (Score)"
 W !,"Data on Complete Referrals Only"
 W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
 W !
 I FOR W !,?33,"Finished",?49,"Basic",?55,"Skilled",?63,"Patient",?73,"TOTAL"
 I FOR W !,"Name",?22,"SSN",?33,"Date",?44,"IADL",?49,"ADL",?55,"Care",?63,"Behaviors",?73,"ACROSS"
 I 'FOR W !,"Name^SSN^Referral Date^IADL^Basic ADL^Skilled Care^Behaviors^Totals"
 W !,"=============================================================================="
 S PAGE=1
 N S1,S2,S3,S4,S5,S1T,S2T,S3T,S4T,S5T
 S (S1T,S2T,S3T,S4T,S5T,CNT)=0
 S DFN="" F  S DFN=$O(@REF@(DFN)) Q:DFN=""  D
 .S SDATE="" F  S SDATE=$O(@REF@(DFN,SDATE)) Q:SDATE=""  D
 ..S DATER="" F  S DATER=$O(@REF@(DFN,SDATE,DATER)) Q:DATER=""  D
 ...S CNT=CNT+1
 ...S S1="" F  S S1=$O(@REF@(DFN,SDATE,DATER,S1)) Q:S1=""  D
 ....S S1T=S1T+S1
 ....S S2="" F  S S2=$O(@REF@(DFN,SDATE,DATER,S1,S2)) Q:S2=""  D
 .....S S2T=S2T+S2
 .....S S3="" F  S S3=$O(@REF@(DFN,SDATE,DATER,S1,S2,S3)) Q:S3=""  D
 ......S S3T=S3T+S3
 ......S S4="" F  S S4=$O(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4)) Q:S4=""  D
 .......S S4T=S4T+S4
 .......S S5="" F  S S5=$O(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4,S5)) Q:S5=""  D
 ........S S5T=S5T+S5
 ........I FOR W !,$E($P(DFN," ",1,$L(DFN," ")-1),1,19),?20," ("_$P(DFN," ",$L(DFN," "))_")",?33,$P($$FMTE^XLFDT(DATER,"5ZM"),"@",1),?44,$J(S1,3),?49,$J(S2,3),?55,$J(S3,3),?63,$J(S4,3),?73,$J(S5,3) D PAGE^PXRMGECZ
 ........I 'FOR W !,$P(DFN," ",1,$L(DFN," ")-1),"^",$P(DFN," ",$L(DFN," ")),"^",$P($$FMTE^XLFDT(DATER,"5ZM"),"@",1),"^",S1,"^",S2,"^",S3,"^",S4,"^",S5 D PAGE^PXRMGECZ
 Q:CNT=0
 I FOR W !,?44,"_________________________________" D PAGE^PXRMGECZ
 I FOR W !,?33,"Totals > >",?44,$J(S1T,3),?49,$J(S2T,3),?55,$J(S3T,3),?63,$J(S4T,3),?72,$J(S5T,4) D PAGE^PXRMGECZ
 I FOR W !,?34,"Means > >",?44,$J($FN(S1T/CNT,"",1),3),?49,$J($FN(S2T/CNT,"",1),3),?55,$J($FN(S3T/CNT,"",1),3),?63,$J($FN(S4T/CNT,"",1),3),?72,$J($FN(S5T/CNT,"",1),4) D PAGE^PXRMGECZ
 S (S1T,S2T,S3T,S4T,S5T,SCNT)=0
 N S1TDEV,S1TDEVT,S2TDEV,S2TDEVT,S3TDEV,S3TDEVT,S4TDEV,S4TDEVT,S5TDEV,S5TDEVT
 S (S1TDEVT,S2TDEVT,S3TDEVT,S4TDEVT,S5TDEVT)=0
 S DFN="" F  S DFN=$O(@REF@(DFN)) Q:DFN=""  D
 .S SDATE="" F  S SDATE=$O(@REF@(DFN,SDATE)) Q:SDATE=""  D
 ..S DATER="" F  S DATER=$O(@REF@(DFN,SDATE,DATER)) Q:DATER=""  D
 ...S S1="" F  S S1=$O(@REF@(DFN,SDATE,DATER,S1)) Q:S1=""  D
 ....S S1TDEV=(S1-(S1T/CNT))*(S1-(S1T/CNT)) S S1TDEVT=S1TDEVT+S1TDEV
 ....S S2="" F  S S2=$O(@REF@(DFN,SDATE,DATER,S1,S2)) Q:S2=""  D
 .....S S2TDEV=(S2-(S2T/CNT))*(S2-(S2T/CNT)) S S2TDEVT=S2TDEVT+S2TDEV
 .....S S3="" F  S S3=$O(@REF@(DFN,SDATE,DATER,S1,S2,S3)) Q:S3=""  D
 ......S S3TDEV=(S3-(S3T/CNT))*(S3-(S3T/CNT)) S S3TDEVT=S3TDEVT+S3TDEV
 ......S S4="" F  S S4=$O(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4)) Q:S4=""  D
 .......S S4TDEV=(S4-(S4T/CNT))*(S4-(S4T/CNT)) S S4TDEVT=S4TDEVT+S4TDEV
 .......S S5="" F  S S5=$O(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4,S5)) Q:S5=""  D
 ........S S5TDEV=(S5-(S5T/CNT))*(S5-(S5T/CNT)) S S5TDEVT=S5TDEVT+S5TDEV
 I FOR W !,?20,"Standard Deviations > >"
 I CNT<2 S CNT=CNT+1
 I FOR W ?44,$J($FN($$SQROOT(S1TDEVT/(CNT-1)),"",1),3),?49,$J($FN($$SQROOT(S2TDEVT/(CNT-1)),"",1),3),?55,$J($FN($$SQROOT(S3TDEVT/(CNT-1)),"",1),3),?63,$J($FN($$SQROOT(S4TDEVT/(CNT-1)),"",1),3)
 I FOR W ?72,$J($FN($$SQROOT(S5TDEVT/(CNT-1)),"",1),4) D PAGE^PXRMGECZ
 K ^TMP("PXRMGEC",$J)
 D KILL^%ZISS
 Q
 ;
SQROOT(NUM) ;Calculat Square Root
 N PREC,ROOT S ROOT=0 GOTO SQROOTX:NUM=0
 S:NUM<0 NUM=-NUM S ROOT=$S(NUM>1:NUM\1,1:1/NUM)
 S ROOT=$E(ROOT,1,$L(ROOT)+1\2) S:NUM'>1 ROOT=1/ROOT
 F PREC=1:1:6 S ROOT=NUM/ROOT+ROOT*.5
SQROOTX Q ROOT
 ;
VALUE(DA) ;Return value for score
 N CAT,SYN,VALUE,PICE
 S SYN=$P($G(^AUTTHF(DA,0)),"^",9)
 Q:$E(SYN,5,5)'="F" VALUE
 Q:SYN="" VALUE
 Q:$E(SYN,5,5)="C" VALUE
 S VALUE=$P(SYN," ",$L(SYN," "))
 Q VALUE
 ;
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECM   5924     printed  Sep 23, 2025@19:21:44                                                                                                                                                                                                    Page 2
PXRMGECM  ;SLC/JVS GEC-Score Reports-cont'd ;7/14/05  10:43
 +1       ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 +2        QUIT 
SUM       ;By Summary by Patient
 +1        NEW CAT,HF,DATE,DFN,Y,HFN,CNTREF,X,REFNUM,SUM,GSUM,CATDANA,PAGE
 +2        NEW DATER,SDATE,SCNT
 +3        DO E^PXRMGECV("HS1",1,BDT,EDT,"F",DFNONLY)
 +4        IF FORMAT="D"
               SET FOR=0
 +5        IF FORMAT="F"
               SET FOR=1
 +6        WRITE @IOF
 +7        SET CATDANA("GEC REFERRAL BASIC ADL")=""
 +8        SET CATDANA("GEC REFERRAL IADL")=""
 +9        SET CATDANA("GEC REFERRAL SKILLED CARE")=""
 +10       SET CATDANA("GEC REFERRAL PATIENT BEHAVIORS/SYMPTOM")=""
 +11      ;
 +12       SET Y=1
           SET SUM=0
           SET DATER=0
           SET GSUM=0
 +13       SET DFN=""
           FOR 
               SET DFN=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN))
               if DFN=""!(Y=0)
                   QUIT 
               Begin DoDot:1
 +14               SET CNTREF=""
                   SET REFNUM=0
                   FOR 
                       SET CNTREF=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF))
                       if CNTREF=""!(Y=0)
                           QUIT 
                       Begin DoDot:2
 +15                       SET REFNUM=REFNUM+1
 +16                       SET SDATE=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,0))
                           Begin DoDot:3
 +17                           SET DATER=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,SDATE,0))
                           End DoDot:3
 +18                       SET DATE=0
                           FOR 
                               SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE))
                               if DATE=""!(Y=0)
                                   QUIT 
                               Begin DoDot:3
 +19                               SET VDT=0
                                   FOR 
                                       SET VDT=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT))
                                       if VDT=""!(Y=0)
                                           QUIT 
                                       Begin DoDot:4
 +20                                       SET CAT=0
                                           FOR 
                                               SET CAT=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT,CAT))
                                               if CAT=""!(Y=0)
                                                   QUIT 
                                               Begin DoDot:5
 +21                                               if '$DATA(CATDANA(CAT))
                                                       QUIT 
 +22                                               SET SUM=0
 +23                                               SET DATEV=0
                                                   FOR 
                                                       SET DATEV=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV))
                                                       if DATEV=""!(Y=0)
                                                           QUIT 
                                                       Begin DoDot:6
 +24                                                       SET DA=0
                                                           FOR 
                                                               SET DA=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV,DA))
                                                               if DA=""!(Y=0)
                                                                   QUIT 
                                                               Begin DoDot:7
 +25                                                               SET HFN=$$HFNAME^PXRMGECR(DA)
 +26                                                               SET SUM=SUM+$$VALUE($PIECE($GET(^AUPNVHF(DA,0)),"^",1))
 +27                                                               SET CATSUM(CAT)=SUM
                                                               End DoDot:7
                                                       End DoDot:6
                                               End DoDot:5
                                       End DoDot:4
                               End DoDot:3
 +28                       SET GSUM=+$GET(CATSUM("GEC REFERRAL IADL"))+(+$GET(CATSUM("GEC REFERRAL BASIC ADL")))+(+$GET(CATSUM("GEC REFERRAL SKILLED CARE")))+(+$GET(CATSUM("GEC REFERRAL PATIENT BEHAVIORS/SYMPTOM")))
 +29                       SET ^TMP("PXRMGEC",$JOB,"S",DFN,SDATE,DATER,+$GET(CATSUM("GEC REFERRAL IADL")),+$GET(CATSUM("GEC REFERRAL BASIC ADL")),+$GET(CATSUM("GEC REFERRAL SKILLED CARE")),+$GET(CATSUM("GEC REFERRAL PATIENT BEHAVIORS/SYMPTOM")),GSUM)=""
 +30                       KILL CATSUM
                       End DoDot:2
               End DoDot:1
 +31      ;
DIS       ;Start of Display
 +1        SET REF="^TMP(""PXRMGEC"",$J,""S"")"
 +2        WRITE !,"=============================================================================="
 +3        WRITE !,"GEC Patient-Summary (Score)"
 +4        WRITE !,"Data on Complete Referrals Only"
 +5        WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
 +6        WRITE !
 +7        IF FOR
               WRITE !,?33,"Finished",?49,"Basic",?55,"Skilled",?63,"Patient",?73,"TOTAL"
 +8        IF FOR
               WRITE !,"Name",?22,"SSN",?33,"Date",?44,"IADL",?49,"ADL",?55,"Care",?63,"Behaviors",?73,"ACROSS"
 +9        IF 'FOR
               WRITE !,"Name^SSN^Referral Date^IADL^Basic ADL^Skilled Care^Behaviors^Totals"
 +10       WRITE !,"=============================================================================="
 +11       SET PAGE=1
 +12       NEW S1,S2,S3,S4,S5,S1T,S2T,S3T,S4T,S5T
 +13       SET (S1T,S2T,S3T,S4T,S5T,CNT)=0
 +14       SET DFN=""
           FOR 
               SET DFN=$ORDER(@REF@(DFN))
               if DFN=""
                   QUIT 
               Begin DoDot:1
 +15               SET SDATE=""
                   FOR 
                       SET SDATE=$ORDER(@REF@(DFN,SDATE))
                       if SDATE=""
                           QUIT 
                       Begin DoDot:2
 +16                       SET DATER=""
                           FOR 
                               SET DATER=$ORDER(@REF@(DFN,SDATE,DATER))
                               if DATER=""
                                   QUIT 
                               Begin DoDot:3
 +17                               SET CNT=CNT+1
 +18                               SET S1=""
                                   FOR 
                                       SET S1=$ORDER(@REF@(DFN,SDATE,DATER,S1))
                                       if S1=""
                                           QUIT 
                                       Begin DoDot:4
 +19                                       SET S1T=S1T+S1
 +20                                       SET S2=""
                                           FOR 
                                               SET S2=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2))
                                               if S2=""
                                                   QUIT 
                                               Begin DoDot:5
 +21                                               SET S2T=S2T+S2
 +22                                               SET S3=""
                                                   FOR 
                                                       SET S3=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2,S3))
                                                       if S3=""
                                                           QUIT 
                                                       Begin DoDot:6
 +23                                                       SET S3T=S3T+S3
 +24                                                       SET S4=""
                                                           FOR 
                                                               SET S4=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4))
                                                               if S4=""
                                                                   QUIT 
                                                               Begin DoDot:7
 +25                                                               SET S4T=S4T+S4
 +26                                                               SET S5=""
                                                                   FOR 
                                                                       SET S5=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4,S5))
                                                                       if S5=""
                                                                           QUIT 
                                                                       Begin DoDot:8
 +27                                                                       SET S5T=S5T+S5
 +28                                                                       IF FOR
                                                                               WRITE !,$EXTRACT($PIECE(DFN," ",1,$LENGTH(DFN," ")-1),1,19),?20," ("_$PIECE(DFN," ",$LENGTH(DFN," "))_")",?33,$PIECE($$FMTE^XLFDT(DATER,"5ZM"),"@",1),?44,$JUSTIFY(S1,3),?49,$JU
STIFY(S2,3),?55,$JUSTIFY(S3,3),?63,$JUSTIFY(S4,3),?73,$JUSTIFY(S5,3)
                                                                               DO PAGE^PXRMGECZ
 +29                                                                       IF 'FOR
                                                                               WRITE !,$PIECE(DFN," ",1,$LENGTH(DFN," ")-1),"^",$PIECE(DFN," ",$LENGTH(DFN," ")),"^",$PIECE($$FMTE^XLFDT(DATER,"5ZM"),"@",1),"^",S1,"^",S2,"^",S3,"^",S4,"^",S5
                                                                               DO PAGE^PXRMGECZ
                                                                       End DoDot:8
                                                               End DoDot:7
                                                       End DoDot:6
                                               End DoDot:5
                                       End DoDot:4
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +30       if CNT=0
               QUIT 
 +31       IF FOR
               WRITE !,?44,"_________________________________"
               DO PAGE^PXRMGECZ
 +32       IF FOR
               WRITE !,?33,"Totals > >",?44,$JUSTIFY(S1T,3),?49,$JUSTIFY(S2T,3),?55,$JUSTIFY(S3T,3),?63,$JUSTIFY(S4T,3),?72,$JUSTIFY(S5T,4)
               DO PAGE^PXRMGECZ
 +33       IF FOR
               WRITE !,?34,"Means > >",?44,$JUSTIFY($FNUMBER(S1T/CNT,"",1),3),?49,$JUSTIFY($FNUMBER(S2T/CNT,"",1),3),?55,$JUSTIFY($FNUMBER(S3T/CNT,"",1),3),?63,$JUSTIFY($FNUMBER(S4T/CNT,"",1),3),?72,$JUSTIFY($FNUMBER(S5T/CNT,"",1),4)
               DO PAGE^PXRMGECZ
 +34       SET (S1T,S2T,S3T,S4T,S5T,SCNT)=0
 +35       NEW S1TDEV,S1TDEVT,S2TDEV,S2TDEVT,S3TDEV,S3TDEVT,S4TDEV,S4TDEVT,S5TDEV,S5TDEVT
 +36       SET (S1TDEVT,S2TDEVT,S3TDEVT,S4TDEVT,S5TDEVT)=0
 +37       SET DFN=""
           FOR 
               SET DFN=$ORDER(@REF@(DFN))
               if DFN=""
                   QUIT 
               Begin DoDot:1
 +38               SET SDATE=""
                   FOR 
                       SET SDATE=$ORDER(@REF@(DFN,SDATE))
                       if SDATE=""
                           QUIT 
                       Begin DoDot:2
 +39                       SET DATER=""
                           FOR 
                               SET DATER=$ORDER(@REF@(DFN,SDATE,DATER))
                               if DATER=""
                                   QUIT 
                               Begin DoDot:3
 +40                               SET S1=""
                                   FOR 
                                       SET S1=$ORDER(@REF@(DFN,SDATE,DATER,S1))
                                       if S1=""
                                           QUIT 
                                       Begin DoDot:4
 +41                                       SET S1TDEV=(S1-(S1T/CNT))*(S1-(S1T/CNT))
                                           SET S1TDEVT=S1TDEVT+S1TDEV
 +42                                       SET S2=""
                                           FOR 
                                               SET S2=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2))
                                               if S2=""
                                                   QUIT 
                                               Begin DoDot:5
 +43                                               SET S2TDEV=(S2-(S2T/CNT))*(S2-(S2T/CNT))
                                                   SET S2TDEVT=S2TDEVT+S2TDEV
 +44                                               SET S3=""
                                                   FOR 
                                                       SET S3=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2,S3))
                                                       if S3=""
                                                           QUIT 
                                                       Begin DoDot:6
 +45                                                       SET S3TDEV=(S3-(S3T/CNT))*(S3-(S3T/CNT))
                                                           SET S3TDEVT=S3TDEVT+S3TDEV
 +46                                                       SET S4=""
                                                           FOR 
                                                               SET S4=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4))
                                                               if S4=""
                                                                   QUIT 
                                                               Begin DoDot:7
 +47                                                               SET S4TDEV=(S4-(S4T/CNT))*(S4-(S4T/CNT))
                                                                   SET S4TDEVT=S4TDEVT+S4TDEV
 +48                                                               SET S5=""
                                                                   FOR 
                                                                       SET S5=$ORDER(@REF@(DFN,SDATE,DATER,S1,S2,S3,S4,S5))
                                                                       if S5=""
                                                                           QUIT 
                                                                       Begin DoDot:8
 +49                                                                       SET S5TDEV=(S5-(S5T/CNT))*(S5-(S5T/CNT))
                                                                           SET S5TDEVT=S5TDEVT+S5TDEV
                                                                       End DoDot:8
                                                               End DoDot:7
                                                       End DoDot:6
                                               End DoDot:5
                                       End DoDot:4
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +50       IF FOR
               WRITE !,?20,"Standard Deviations > >"
 +51       IF CNT<2
               SET CNT=CNT+1
 +52       IF FOR
               WRITE ?44,$JUSTIFY($FNUMBER($$SQROOT(S1TDEVT/(CNT-1)),"",1),3),?49,$JUSTIFY($FNUMBER($$SQROOT(S2TDEVT/(CNT-1)),"",1),3),?55,$JUSTIFY($FNUMBER($$SQROOT(S3TDEVT/(CNT-1)),"",1),3),?63,$JUSTIFY($FNUMBER($$SQROOT(S4TDEVT/(CNT-1)),"",1),3)
 +53       IF FOR
               WRITE ?72,$JUSTIFY($FNUMBER($$SQROOT(S5TDEVT/(CNT-1)),"",1),4)
               DO PAGE^PXRMGECZ
 +54       KILL ^TMP("PXRMGEC",$JOB)
 +55       DO KILL^%ZISS
 +56       QUIT 
 +57      ;
SQROOT(NUM) ;Calculat Square Root
 +1        NEW PREC,ROOT
           SET ROOT=0
           if NUM=0
               GOTO SQROOTX
 +2        if NUM<0
               SET NUM=-NUM
           SET ROOT=$SELECT(NUM>1:NUM\1,1:1/NUM)
 +3        SET ROOT=$EXTRACT(ROOT,1,$LENGTH(ROOT)+1\2)
           if NUM'>1
               SET ROOT=1/ROOT
 +4        FOR PREC=1:1:6
               SET ROOT=NUM/ROOT+ROOT*.5
SQROOTX    QUIT ROOT
 +1       ;
VALUE(DA) ;Return value for score
 +1        NEW CAT,SYN,VALUE,PICE
 +2        SET SYN=$PIECE($GET(^AUTTHF(DA,0)),"^",9)
 +3        if $EXTRACT(SYN,5,5)'="F"
               QUIT VALUE
 +4        if SYN=""
               QUIT VALUE
 +5        if $EXTRACT(SYN,5,5)="C"
               QUIT VALUE
 +6        SET VALUE=$PIECE(SYN," ",$LENGTH(SYN," "))
 +7        QUIT VALUE
 +8       ;
 +9       ;