- 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 Feb 18, 2025@23:12:07 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 ;
