- 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
- GMTSGAF ; SLC/KER - MH Gbl Assessment Funct (GAF) ; 6/20/05 1:44pm
- +1 ;;2.7;Health Summary;**35,44,49,74**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10035 ^DPT(
- +5 ; DBIA 10003 ^%DT
- +6 ; DBIA 10088 DEM^VADPT
- +7 ; DBIA 10103 $$FMADD^XLFDT
- +8 ; DBIA 10103 $$FMTE^XLFDT
- +9 ; DBIA 10103 $$NOW^XLFDT
- +10 ; DBIA 2896 GAFHX^YSGAFAPI
- +11 ;
- +12 QUIT
- EN ; Global Assessment Functioning Score
- +1 NEW MAX
- SET MAX=$SELECT(+($GET">GET(GMTSNDM))>0:+($GET">GET(GMTSNDM)),1:9999999)
- +2 IF +($GET(GMTSBEG))'>2700101
- SET GMTSBEG=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-1095,0,0,1)
- SET GMTSEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),1,0,0,1)
- SET GMTS2=9999999-GMTSBEG
- SET GMTS1=9999999-GMTSEND
- +3 IF '$LENGTH($PIECE(GMTSBEG,".",2))
- SET GMTSBEG=$$FMADD^XLFDT(GMTSBEG,0,0,0,1)
- +4 IF +($GET">GET(GMTSEND))'>2700101!(+($GET">GET(GMTSEND))>+($$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),+1,0,0,2)))
- SET GMTSEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),1,0,0,1)
- SET GMTS1=9999999-GMTSEND
- +5 IF '$LENGTH($PIECE(GMTSEND,".",2))
- SET GMTSEND=$$FMADD^XLFDT(GMTSEND,0,0,0,1)
- +6 IF +($GET">GET(GMTSEND))>0&(+($GET">GET(GMTS1))=0)
- SET GMTS1=9999999-GMTSEND
- IF +($GET">GET(GMTSBEG))>0&(+($GET">GET(GMTS2))=0)
- SET GMTS2=9999999-GMTSBEG
- +7 SET GMTSLO=+($GET(GMTSLO))
- IF GMTSLO=0
- SET GMTSLO=3
- SET GMTSLPG=+($GET(GMTSLPG))
- SET GMTSDTM=$GET(GMTSDTM)
- IF '$LENGTH(GMTSDTM)
- SET GMTSDTM=$$DTM
- +8 IF '$DATA(GMTSTITL)!('$LENGTH($GET(GMTSTITL)))
- SET GMTSTITL="GLOBAL ASSESSMENT FUNCTIONING"
- +9 SET DFN=+($GET(DFN))
- IF '$LENGTH($PIECE($GET(^DPT(DFN,0)),"^",1))
- QUIT
- +10 NEW %,%DT,%H,%I,%T,%X,I,N,VA,VADM,VAERR,X,Y,YS,YSGAF
- +11 NEW GMTSBAR,GMTSCNT,GMTSCOM,GMTSCORE,GMTSCS,GMTSCW,GMTSDATE,GMTSDT
- +12 NEW GMTSGAF,GMTSGAF1,GMTSGAF2,GMTSGAF3,GMTSGAFN,GMTSI,GMTSJ,GMTSLEN,GMTSPROV,GMTSRV
- +13 SET GMTSGAF1=$$EXT(+($GET(GMTS1)))
- SET GMTSGAF2=$$ITM(+($GET(GMTS2)))
- SET GMTSGAF3=$$TOM
- +14 SET GMTSGAFN=+($GET(MAX))
- IF GMTSGAFN=0
- SET GMTSGAFN=10
- +15 SET GMTSCW(0)=+($GET(IOM))
- IF GMTSCW(0)=0
- SET GMTSCW(0)=80
- +16 SET GMTSCW(1)=5
- SET GMTSCW(2)=10
- SET GMTSCW(3)=20
- SET GMTSCW(4)=GMTSCW(0)-(GMTSCW(1)+GMTSCW(2)+GMTSCW(3)+8)
- +17 SET GMTSCW("L")=(GMTSCW(1)+GMTSCW(2)+GMTSCW(3)+GMTSCW(4)+6)
- +18 SET GMTSCS(1)=1
- SET GMTSCS(2)=GMTSCS(1)+GMTSCW(1)+2
- SET GMTSCS(3)=GMTSCS(2)+GMTSCW(2)+2
- SET GMTSCS(4)=GMTSCS(3)+GMTSCW(3)+2
- +19 SET YS("DFN")=DFN
- SET YS("BEGIN")=$SELECT($LENGTH(GMTSGAF2):GMTSGAF2,1:GMTSGAF3)
- +20 SET YS("END")=$SELECT($LENGTH(GMTSGAF1):GMTSGAF1,1:"01/01/1970")
- SET YS("LIMIT")=GMTSGAFN
- +21 DO GET
- IF '$DATA(^TMP($JOB,"GMTSGAF",DFN))
- QUIT
- DO OUT
- QUIT
- OUT ; Output
- +1 NEW GMTSI,GMTSJ,GMTSCORE,GMTSDATE,GMTSPROV,GMTSCOM
- SET DFN=+($GET(DFN))
- IF DFN=0
- QUIT
- DO HDR
- SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^TMP($JOB,"GMTSGAF",DFN,GMTSI))
- IF +GMTSI=0
- QUIT
- Begin DoDot:1
- +2 SET GMTSJ=$GET(^TMP($JOB,"GMTSGAF",DFN,GMTSI))
- +3 SET GMTSCORE=$PIECE(GMTSJ,"^",1)
- SET GMTSDATE=$PIECE(GMTSJ,"^",2)
- SET GMTSPROV=$PIECE(GMTSJ,"^",3)
- SET GMTSCOM=$PIECE(GMTSJ,"^",4)
- IF GMTSCORE=""&(GMTSDATE["----")&($LENGTH(GMTSCOM))
- SET GMTSCORE=">>"
- DO LINE
- End DoDot:1
- +4 KILL ^TMP($JOB,"GMTSGAF",DFN)
- QUIT
- LINE ; Output One Line
- +1 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG=1
- DO HDR
- WRITE ?GMTSCS(1),$JUSTIFY($EXTRACT(GMTSCORE,1,3),3),?GMTSCS(2),GMTSDATE,?GMTSCS(3),$EXTRACT(GMTSPROV,1,GMTSCW(3)),?GMTSCS(4),GMTSCOM,!
- QUIT
- HDR ; Header
- +1 NEW GMTSI
- SET GMTSI=""
- SET $PIECE(GMTSI,"-",+($GET(GMTSCW("L"))))="-"
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG=1
- GOTO HDR
- WRITE ?GMTSCS(1)," GAF ",?GMTSCS(2),"Date",!
- +3 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG=1
- GOTO HDR
- WRITE ?GMTSCS(1),"Score",?GMTSCS(2),"Determined",?GMTSCS(3),"Determined by",?GMTSCS(4),"Graph/Comment",!
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG=1
- GOTO HDR
- WRITE ?GMTSCS(1),GMTSI,!
- +5 QUIT
- GET ; Get and Format Data
- +1 NEW %DT,X,Y,GMTSGPH,GMTSCORE,GMTSDT,GMTSDATE,GMTSPROV,GMTSCOM
- SET DFN=+($GET(DFN))
- SET GMTSGPH=0
- KILL ^TMP($JOB,"GMTSGAF",DFN),YSGAF
- DO GAFHX^YSGAFAPI(.YSGAF,.YS)
- DO SPC
- +2 IF +($PIECE($GET(YSGAF("DEC")),".",1))>0
- Begin DoDot:1
- +3 SET GMTSDT=+($PIECE($GET(YSGAF("DEC")),".",1))
- SET GMTSCOM="Deceased ("_$$FMTE^XLFDT(GMTSDT,"5ZD")_")"
- DO SD(GMTSDT,DFN,"","","",GMTSCOM)
- End DoDot:1
- +4 IF +($PIECE($GET(YSGAF("DUE")),".",1))>0
- Begin DoDot:1
- +5 SET GMTSDT=+($PIECE($GET(YSGAF("DUE")),".",1))
- IF GMTSDT>$$TOD
- QUIT
- SET GMTSCOM="Due since "_$$FMTE^XLFDT(GMTSDT,"5ZD")
- DO SD(GMTSDT,DFN,"","","",GMTSCOM)
- End DoDot:1
- +6 NEW I
- SET I=1
- FOR
- SET I=$ORDER(YSGAF(I))
- IF +I=0
- QUIT
- Begin DoDot:1
- +7 SET GMTSDT=$PIECE(YSGAF(I),"^",1)
- SET GMTSDATE=$PIECE(GMTSDT,".",1)
- SET GMTSDATE=$$FMTE^XLFDT(GMTSDATE,"5ZD")
- +8 IF +($GET">GET(YSGAF("DEC")))>0&(+GMTSDATE>+($GET">GET(YSGAF("DEC"))))
- QUIT
- +9 SET GMTSCORE=$PIECE(YSGAF(I),"^",5)
- SET GMTSPROV=$PIECE(YSGAF(I),"^",7)
- +10 SET GMTSCOM=+($PIECE($GET(YSGAF("ERR",I)),".",1))
- IF +GMTSCOM=0
- SET GMTSCOM=""
- +11 IF +GMTSCOM>0
- SET GMTSCOM="Entered in error ("_$$FMTE^XLFDT(GMTSCOM,"5ZD")_")"
- +12 IF GMTSCOM=""
- SET GMTSCOM=$$B(GMTSCORE,31)
- +13 IF '$DATA(YSGAF("ERR",I))
- DO SD(GMTSDT,DFN,GMTSCORE,GMTSDATE,GMTSPROV,GMTSCOM)
- End DoDot:1
- +14 QUIT
- SPC ; Get Special Case (Deceased, Due, Entered-in-Error)
- +1 NEW GMTSI
- SET YSGAF("P")=$PIECE($GET">GET(^DPT(+($GET">GET(DFN)),0)),"^",1)
- +2 SET GMTSI=$$DEC(+($GET(DFN)))
- IF +GMTSI>0
- SET YSGAF("DEC")=GMTSI
- IF +GMTSI=0
- SET GMTSI=$$DUE
- IF +GMTSI>0
- SET YSGAF("DUE")=GMTSI
- +3 IF +($GET(YSGAF("DEC")))>0
- KILL YSGAF("DUE")
- SET GMTSI=$$ERR
- IF +GMTSI>0
- SET YSGAF("ERR")=GMTSI
- +4 QUIT
- SD(GMTSI,DFN,GMTSCORE,GMTSDATE,GMTSPROV,GMTSCOM) ; Save Data
- +1 NEW GMTSIG
- SET (GMTSCORE,GMTSIG)=$GET(GMTSCORE)
- SET GMTSCORE=$$GAF(GMTSCORE)
- SET DFN=+($GET(DFN))
- +2 SET GMTSIG=100-(+($GET(GMTSIG)))
- +3 SET GMTSI=+($GET(GMTSI))
- SET GMTSI=9999999.999999-GMTSI
- +4 SET GMTSPROV=$GET(GMTSPROV)
- SET GMTSDATE=$GET(GMTSDATE)
- +5 SET GMTSIG=GMTSI_GMTSIG_GMTSPROV_GMTSDATE
- +6 IF GMTSDATE=""
- SET GMTSDATE="--/--/----"
- +7 SET ^TMP($JOB,"GMTSGAF",DFN,GMTSIG)=GMTSCORE_"^"_GMTSDATE_"^"_GMTSPROV_"^"_$GET(GMTSCOM)
- +8 QUIT
- ERR(X) ; Entered in Error
- +1 NEW GMTSCNT,GMTSI,GMTSGAF,GMTSJ,GMTSDATE
- SET (GMTSCNT,GMTSI)=0
- SET GMTSDATE=""
- FOR
- SET GMTSI=$ORDER(YSGAF(GMTSI))
- IF +GMTSI=0
- QUIT
- Begin DoDot:1
- +2 SET GMTSGAF=$PIECE(YSGAF(GMTSI),"^",8)
- IF GMTSGAF'["entered in error"
- QUIT
- +3 SET YSGAF("ERR")=""
- FOR GMTSJ=1:1:$LENGTH(GMTSGAF," ")
- Begin DoDot:2
- +4 IF $PIECE(GMTSGAF," ",GMTSJ)["@"&(GMTSJ>2)
- SET GMTSDATE=$PIECE(GMTSGAF," ",GMTSJ-1,GMTSJ)
- IF $LENGTH(GMTSDATE)
- SET GMTSDATE=$$ETF(GMTSDATE)
- End DoDot:2
- +5 IF $LENGTH(GMTSDATE)
- SET YSGAF("ERR",GMTSI)=GMTSDATE
- SET GMTSCNT=GMTSCNT+1
- End DoDot:1
- +6 SET X=GMTSCNT
- QUIT X
- DUE(X) ; GAF Score Due Date
- +1 IF '$DATA(YSGAF(2))
- SET YSGAF(1)="[NO DATA]"
- NEW GMTSI,GMTSJ,GMTSDATE
- SET (GMTSI,GMTSJ,GMTSDATE)=0
- +2 FOR
- SET GMTSI=$ORDER(YSGAF(GMTSI))
- IF +GMTSI=0
- QUIT
- SET GMTSJ=$PIECE(YSGAF(GMTSI),"^",1)
- IF GMTSJ>GMTSDATE
- SET GMTSDATE=GMTSJ
- +3 SET GMTSDATE=$SELECT(GMTSDATE>0:$$FMADD^XLFDT(GMTSDATE,90,0,0,0),1:"")
- SET X=GMTSDATE
- QUIT X
- ITM(X) ; convert inverse internal date to internal date to external date
- +1 ; temp scratch variable to hold value of X
- NEW SAVX
- +2 ; produce an internal date
- SET X=+($GET(X))
- SET X=9999999-X
- +3 SET SAVX=X
- +4 ; if not valid date, default to 3 years ago
- SET X=$$FMTE^XLFDT(X,"5ZD")
- DO ^%DT
- IF Y=-1
- Begin DoDot:1
- +5 SET X1=$$NOW^XLFDT
- SET X2=-1095
- DO C^%DTC
- SET SAVX=X
- End DoDot:1
- +6 SET X=SAVX
- +7 ; produce external format
- SET X=$$FMTE^XLFDT(X,"5ZD")
- +8 QUIT X
- EXT(X) ; convert inverse internal date to internal date, add one day, then to external date
- +1 ; temp scratch variable to hold value of X
- NEW SAVX
- +2 ; produce an internal date
- SET X=+($GET(X))
- SET X=9999999-X
- +3 SET SAVX=X
- +4 ; if not valid date, set to NOW
- SET X=$$FMTE^XLFDT(X,"5ZD")
- DO ^%DT
- IF Y=-1
- SET SAVX=$$NOW^XLFDT
- +5 SET X=SAVX
- +6 ; add one day so any GAF data entered today will appear on output
- SET X=$$FMADD^XLFDT(X,1,0,0,0)
- +7 ; output in external format
- SET X=$$FMTE^XLFDT(X,"5ZD")
- +8 QUIT X
- ETF(X) ; External to Fileman format
- +1 NEW %DT,Y
- SET X=$GET(X)
- SET %DT="PST"
- DO ^%DT
- SET X=Y
- IF +X'>0
- SET X=""
- QUIT X
- TOM(X) ; Tomorrow
- +1 SET X=$$FMTE^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,1,0,0,0),"5ZD")
- QUIT X
- TOD(X) ; Today
- +1 SET X=$$NOW^XLFDT
- QUIT X
- DEC(X) ; Deceased Date
- +1 NEW %,%H,%I,%X,%T,VA,VADM,VAERR,DFN
- SET DFN=+($GET(X))
- IF DFN=0
- QUIT ""
- IF '$DATA(^DPT(+DFN,0))
- QUIT ""
- +2 DO DEM^VADPT
- SET X=+$GET(VADM(6))
- IF X=0
- SET X=""
- QUIT X
- B(X,Y) ; Graph Bar
- +1 NEW GMTSGAF,GMTSCHAR,GMTSCW,GMTSLEN,GMTSI,GMTSBAR
- SET GMTSGAF=$GET(X)
- SET GMTSCW=+($GET(Y))
- IF GMTSCW=0
- QUIT ""
- +2 SET GMTSCHAR="#"
- FOR
- IF $EXTRACT(GMTSGAF,1)'="0"
- QUIT
- SET GMTSGAF=$EXTRACT(GMTSGAF,2,$LENGTH(GMTSGAF))
- +3 SET GMTSGAF=+GMTSGAF
- IF GMTSGAF=0
- QUIT ""
- +4 IF GMTSGAF>99
- SET GMTSBAR=""
- SET $PIECE(GMTSBAR,GMTSCHAR,GMTSCW)=GMTSCHAR
- +5 IF GMTSGAF'>99
- SET GMTSI=GMTSCW/100
- SET GMTSLEN=GMTSI*GMTSGAF
- SET GMTSLEN=$FNUMBER(GMTSLEN,"",0)
- SET GMTSBAR=""
- SET $PIECE(GMTSBAR,GMTSCHAR,GMTSLEN)=GMTSCHAR
- +6 SET X=GMTSBAR
- QUIT X
- GAF(X) ; 2 Digit GAF Score
- +1 SET X=$EXTRACT($GET(X),1,3)
- IF X=""!(X="---")
- QUIT ""
- SET X=+X
- IF X=0
- QUIT " 0"
- IF $LENGTH(X)=1
- SET X=" "_X
- IF $LENGTH(X)=2
- SET X=" "_X
- QUIT X
- DTM(X) ; Current Date and Time (External)
- +1 SET X=$$NOW^XLFDT
- DO REGDTM4^GMTSU
- QUIT X
