Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSGAF

GMTSGAF.m

Go to the documentation of this file.
GMTSGAF ; SLC/KER - MH Gbl Assessment Funct (GAF)    ; 6/20/05 1:44pm

 ;;2.7;Health Summary;**35,44,49,74**;Oct 20, 1995

 ;                  

 ; External References

 ;   DBIA 10035  ^DPT(

 ;   DBIA 10003  ^%DT

 ;   DBIA 10088  DEM^VADPT

 ;   DBIA 10103  $$FMADD^XLFDT

 ;   DBIA 10103  $$FMTE^XLFDT

 ;   DBIA 10103  $$NOW^XLFDT

 ;   DBIA  2896  GAFHX^YSGAFAPI

 ;                     

 Q

EN ; Global Assessment Functioning Score

 N MAX S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:9999999)

 S:+($G(GMTSBEG))'>2700101 GMTSBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1095,0,0,1),GMTSEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),1,0,0,1),GMTS2=9999999-GMTSBEG,GMTS1=9999999-GMTSEND

 S:'$L($P(GMTSBEG,".",2)) GMTSBEG=$$FMADD^XLFDT(GMTSBEG,0,0,0,1)

 S:+($G(GMTSEND))'>2700101!(+($G(GMTSEND))>+($$FMADD^XLFDT($P($$NOW^XLFDT,".",1),+1,0,0,2))) GMTSEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),1,0,0,1),GMTS1=9999999-GMTSEND

 S:'$L($P(GMTSEND,".",2)) GMTSEND=$$FMADD^XLFDT(GMTSEND,0,0,0,1)

 S:+($G(GMTSEND))>0&(+($G(GMTS1))=0) GMTS1=9999999-GMTSEND S:+($G(GMTSBEG))>0&(+($G(GMTS2))=0) GMTS2=9999999-GMTSBEG

 S GMTSLO=+($G(GMTSLO)) S:GMTSLO=0 GMTSLO=3 S GMTSLPG=+($G(GMTSLPG)),GMTSDTM=$G(GMTSDTM) S:'$L(GMTSDTM) GMTSDTM=$$DTM

 S:'$D(GMTSTITL)!('$L($G(GMTSTITL))) GMTSTITL="GLOBAL ASSESSMENT FUNCTIONING"

 S DFN=+($G(DFN)) Q:'$L($P($G(^DPT(DFN,0)),"^",1))

 N %,%DT,%H,%I,%T,%X,I,N,VA,VADM,VAERR,X,Y,YS,YSGAF

 N GMTSBAR,GMTSCNT,GMTSCOM,GMTSCORE,GMTSCS,GMTSCW,GMTSDATE,GMTSDT

 N GMTSGAF,GMTSGAF1,GMTSGAF2,GMTSGAF3,GMTSGAFN,GMTSI,GMTSJ,GMTSLEN,GMTSPROV,GMTSRV

 S GMTSGAF1=$$EXT(+($G(GMTS1))),GMTSGAF2=$$ITM(+($G(GMTS2))),GMTSGAF3=$$TOM

 S GMTSGAFN=+($G(MAX)) S:GMTSGAFN=0 GMTSGAFN=10

 S GMTSCW(0)=+($G(IOM)) S:GMTSCW(0)=0 GMTSCW(0)=80

 S GMTSCW(1)=5,GMTSCW(2)=10,GMTSCW(3)=20,GMTSCW(4)=GMTSCW(0)-(GMTSCW(1)+GMTSCW(2)+GMTSCW(3)+8)

 S GMTSCW("L")=(GMTSCW(1)+GMTSCW(2)+GMTSCW(3)+GMTSCW(4)+6)

 S GMTSCS(1)=1,GMTSCS(2)=GMTSCS(1)+GMTSCW(1)+2,GMTSCS(3)=GMTSCS(2)+GMTSCW(2)+2,GMTSCS(4)=GMTSCS(3)+GMTSCW(3)+2

 S YS("DFN")=DFN,YS("BEGIN")=$S($L(GMTSGAF2):GMTSGAF2,1:GMTSGAF3)

 S YS("END")=$S($L(GMTSGAF1):GMTSGAF1,1:"01/01/1970"),YS("LIMIT")=GMTSGAFN

 D GET Q:'$D(^TMP($J,"GMTSGAF",DFN))  D OUT Q

OUT ; Output

 N GMTSI,GMTSJ,GMTSCORE,GMTSDATE,GMTSPROV,GMTSCOM S DFN=+($G(DFN)) Q:DFN=0  D HDR S GMTSI=0 F  S GMTSI=$O(^TMP($J,"GMTSGAF",DFN,GMTSI)) Q:+GMTSI=0  D

 . S GMTSJ=$G(^TMP($J,"GMTSGAF",DFN,GMTSI))

 . S GMTSCORE=$P(GMTSJ,"^",1),GMTSDATE=$P(GMTSJ,"^",2),GMTSPROV=$P(GMTSJ,"^",3),GMTSCOM=$P(GMTSJ,"^",4) S:GMTSCORE=""&(GMTSDATE["----")&($L(GMTSCOM)) GMTSCORE=">>" D LINE

 K ^TMP($J,"GMTSGAF",DFN) Q

LINE ; Output One Line

 D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG=1 HDR W ?GMTSCS(1),$J($E(GMTSCORE,1,3),3),?GMTSCS(2),GMTSDATE,?GMTSCS(3),$E(GMTSPROV,1,GMTSCW(3)),?GMTSCS(4),GMTSCOM,! Q

HDR ; Header

 N GMTSI S GMTSI="",$P(GMTSI,"-",+($G(GMTSCW("L"))))="-"

 D CKP^GMTSUP Q:$D(GMTSQIT)  G:GMTSNPG=1 HDR W ?GMTSCS(1)," GAF ",?GMTSCS(2),"Date",!

 D CKP^GMTSUP Q:$D(GMTSQIT)  G:GMTSNPG=1 HDR W ?GMTSCS(1),"Score",?GMTSCS(2),"Determined",?GMTSCS(3),"Determined by",?GMTSCS(4),"Graph/Comment",!

 D CKP^GMTSUP Q:$D(GMTSQIT)  G:GMTSNPG=1 HDR W ?GMTSCS(1),GMTSI,!

 Q

GET ; Get and Format Data

 N %DT,X,Y,GMTSGPH,GMTSCORE,GMTSDT,GMTSDATE,GMTSPROV,GMTSCOM S DFN=+($G(DFN)),GMTSGPH=0 K ^TMP($J,"GMTSGAF",DFN),YSGAF D GAFHX^YSGAFAPI(.YSGAF,.YS),SPC

 I +($P($G(YSGAF("DEC")),".",1))>0 D

 . S GMTSDT=+($P($G(YSGAF("DEC")),".",1)),GMTSCOM="Deceased ("_$$FMTE^XLFDT(GMTSDT,"5ZD")_")" D SD(GMTSDT,DFN,"","","",GMTSCOM)

 I +($P($G(YSGAF("DUE")),".",1))>0 D

 . S GMTSDT=+($P($G(YSGAF("DUE")),".",1)) Q:GMTSDT>$$TOD  S GMTSCOM="Due since "_$$FMTE^XLFDT(GMTSDT,"5ZD") D SD(GMTSDT,DFN,"","","",GMTSCOM)

 N I S I=1 F  S I=$O(YSGAF(I)) Q:+I=0  D

 . S GMTSDT=$P(YSGAF(I),"^",1),GMTSDATE=$P(GMTSDT,".",1),GMTSDATE=$$FMTE^XLFDT(GMTSDATE,"5ZD")

 . Q:+($G(YSGAF("DEC")))>0&(+GMTSDATE>+($G(YSGAF("DEC"))))

 . S GMTSCORE=$P(YSGAF(I),"^",5),GMTSPROV=$P(YSGAF(I),"^",7)

 . S GMTSCOM=+($P($G(YSGAF("ERR",I)),".",1)) S:+GMTSCOM=0 GMTSCOM=""

 . S:+GMTSCOM>0 GMTSCOM="Entered in error ("_$$FMTE^XLFDT(GMTSCOM,"5ZD")_")"

 . S:GMTSCOM="" GMTSCOM=$$B(GMTSCORE,31)

 . D:'$D(YSGAF("ERR",I)) SD(GMTSDT,DFN,GMTSCORE,GMTSDATE,GMTSPROV,GMTSCOM)

 Q

SPC ; Get Special Case (Deceased, Due, Entered-in-Error)

 N GMTSI S YSGAF("P")=$P($G(^DPT(+($G(DFN)),0)),"^",1)

 S GMTSI=$$DEC(+($G(DFN))) S:+GMTSI>0 YSGAF("DEC")=GMTSI I +GMTSI=0 S GMTSI=$$DUE S:+GMTSI>0 YSGAF("DUE")=GMTSI

 K:+($G(YSGAF("DEC")))>0 YSGAF("DUE") S GMTSI=$$ERR S:+GMTSI>0 YSGAF("ERR")=GMTSI

 Q

SD(GMTSI,DFN,GMTSCORE,GMTSDATE,GMTSPROV,GMTSCOM) ; Save Data

 N GMTSIG S (GMTSCORE,GMTSIG)=$G(GMTSCORE),GMTSCORE=$$GAF(GMTSCORE),DFN=+($G(DFN))

 S GMTSIG=100-(+($G(GMTSIG)))

 S GMTSI=+($G(GMTSI)),GMTSI=9999999.999999-GMTSI

 S GMTSPROV=$G(GMTSPROV),GMTSDATE=$G(GMTSDATE)

 S GMTSIG=GMTSI_GMTSIG_GMTSPROV_GMTSDATE

 S:GMTSDATE="" GMTSDATE="--/--/----"

 S ^TMP($J,"GMTSGAF",DFN,GMTSIG)=GMTSCORE_"^"_GMTSDATE_"^"_GMTSPROV_"^"_$G(GMTSCOM)

 Q

ERR(X) ; Entered in Error

 N GMTSCNT,GMTSI,GMTSGAF,GMTSJ,GMTSDATE S (GMTSCNT,GMTSI)=0,GMTSDATE="" F  S GMTSI=$O(YSGAF(GMTSI)) Q:+GMTSI=0  D

 . S GMTSGAF=$P(YSGAF(GMTSI),"^",8) Q:GMTSGAF'["entered in error"

 . S YSGAF("ERR")="" F GMTSJ=1:1:$L(GMTSGAF," ") D

 .. S:$P(GMTSGAF," ",GMTSJ)["@"&(GMTSJ>2) GMTSDATE=$P(GMTSGAF," ",GMTSJ-1,GMTSJ) S:$L(GMTSDATE) GMTSDATE=$$ETF(GMTSDATE)

 . S:$L(GMTSDATE) YSGAF("ERR",GMTSI)=GMTSDATE,GMTSCNT=GMTSCNT+1

 S X=GMTSCNT Q X

DUE(X) ; GAF Score Due Date

 S:'$D(YSGAF(2)) YSGAF(1)="[NO DATA]" N GMTSI,GMTSJ,GMTSDATE S (GMTSI,GMTSJ,GMTSDATE)=0

 F  S GMTSI=$O(YSGAF(GMTSI)) Q:+GMTSI=0  S GMTSJ=$P(YSGAF(GMTSI),"^",1) S:GMTSJ>GMTSDATE GMTSDATE=GMTSJ

 S GMTSDATE=$S(GMTSDATE>0:$$FMADD^XLFDT(GMTSDATE,90,0,0,0),1:"") S X=GMTSDATE Q X

ITM(X) ; convert inverse internal date to internal date to external date

 N SAVX  ;  temp scratch variable to hold value of X

 S X=+($G(X)),X=9999999-X  ; produce an internal date

 S SAVX=X

 S X=$$FMTE^XLFDT(X,"5ZD") D ^%DT I Y=-1 D  ; if not valid date, default to 3 years ago

 . S X1=$$NOW^XLFDT,X2=-1095 D C^%DTC S SAVX=X

 S X=SAVX

 S X=$$FMTE^XLFDT(X,"5ZD")    ; produce external format

 Q X

EXT(X) ; convert inverse internal date to internal date, add one day, then to external date

 N SAVX  ;  temp scratch variable to hold value of X

 S X=+($G(X)),X=9999999-X  ; produce an internal date

 S SAVX=X

 S X=$$FMTE^XLFDT(X,"5ZD") D ^%DT I Y=-1 S SAVX=$$NOW^XLFDT ; if not valid date, set to NOW

 S X=SAVX

 S X=$$FMADD^XLFDT(X,1,0,0,0) ; add one day so any GAF data entered today will appear on output

 S X=$$FMTE^XLFDT(X,"5ZD")    ; output in external format

 Q X

ETF(X) ; External to Fileman format

 N %DT,Y S X=$G(X),%DT="PST" D ^%DT S X=Y S:+X'>0 X="" Q X

TOM(X) ; Tomorrow

 S X=$$FMTE^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,1,0,0,0),"5ZD") Q X

TOD(X) ; Today

 S X=$$NOW^XLFDT Q X

DEC(X) ; Deceased Date

 N %,%H,%I,%X,%T,VA,VADM,VAERR,DFN S DFN=+($G(X)) Q:DFN=0 "" Q:'$D(^DPT(+DFN,0)) ""

 D DEM^VADPT S X=+$G(VADM(6)) S:X=0 X="" Q X

B(X,Y) ; Graph Bar

 N GMTSGAF,GMTSCHAR,GMTSCW,GMTSLEN,GMTSI,GMTSBAR S GMTSGAF=$G(X),GMTSCW=+($G(Y)) Q:GMTSCW=0 ""

 S GMTSCHAR="#" F  Q:$E(GMTSGAF,1)'="0"  S GMTSGAF=$E(GMTSGAF,2,$L(GMTSGAF))

 S GMTSGAF=+GMTSGAF Q:GMTSGAF=0 ""

 I GMTSGAF>99 S GMTSBAR="",$P(GMTSBAR,GMTSCHAR,GMTSCW)=GMTSCHAR

 I GMTSGAF'>99 S GMTSI=GMTSCW/100,GMTSLEN=GMTSI*GMTSGAF,GMTSLEN=$FN(GMTSLEN,"",0),GMTSBAR="",$P(GMTSBAR,GMTSCHAR,GMTSLEN)=GMTSCHAR

 S X=GMTSBAR Q X

GAF(X) ; 2 Digit GAF Score

 S X=$E($G(X),1,3) Q:X=""!(X="---") "" S X=+X Q:X=0 "  0" S:$L(X)=1 X="  "_X S:$L(X)=2 X=" "_X Q X

DTM(X) ; Current Date and Time (External)

 S X=$$NOW^XLFDT D REGDTM4^GMTSU Q X