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

YSGAF.m

Go to the documentation of this file.
  1. YSGAF ;ALB/ASF-GLOBAL ASSESSMENT OF FUNCTIONING ;11/10/97 16:17
  1. ;;5.01;MENTAL HEALTH;**33,37,40,42,43,51,49,187**;Dec 30, 1994;Build 73
  1. ;
  1. Q
  1. CLENT ;
  1. N %DT,DA,DIE,DIR,DIRUT,DLAYGO,DR,K,VA,VADM,X,X1,X2,Y,YSCLIN,YSCNAME,YSDA,YSDATE,YSDAYS,YSDD,YSDXEG,YSDXEL,YSDXEN,YSG,YSGAFLC,YSGAFLD,YSGAFLN,YSGC,YSGD,YSGN,YSGR,YSGT,YSLINE,YSN,YSONLY,YSOUT,YSPAGE,YSPTN,YSRULE,YSSTOP,YSGAFER
  1. W @IOF,"Clinic Entry: Global Assessment of Functioning",!
  1. D ONELOC^YSGAF1 Q:YSCLIN=""
  1. D DATE^YSGAF1 Q:YSDATE<1
  1. S YSDAYS=90
  1. D ONLYREQ^YSGAF1 Q:YSONLY=""
  1. D LP1^YSGAF1
  1. I '$D(^TMP("YSGAF",$J)) W !,"No GAF's to enter" Q
  1. CE1 S YSN="",YSOUT=0 F S YSN=$O(^TMP("YSGAF",$J,"A",YSN)) Q:YSN=""!(YSOUT) S DFN=0 F S DFN=$O(^TMP("YSGAF",$J,"A",YSN,DFN)) Q:DFN'>0 D
  1. .D RULE Q:('YSRULE)&(YSONLY)
  1. .W !
  1. .D DISP5,ADD5
  1. Q
  1. RULE ;business rule for need dx
  1. S YSRULE=0
  1. D CK
  1. I YSGAFLD'?7N.E S YSRULE=1 Q
  1. S X1=DT,X2=YSGAFLD D ^%DTC
  1. S:X>YSDAYS YSRULE=1
  1. Q
  1. CK ;check last Axis 5
  1. S (YSGAFLN,YSGAFLD,YSGAFLC,YSGAFER)=""
  1. S YSDXEL=$O(^YSD(627.8,"AX5",DFN,-1))
  1. Q:YSDXEL<1
  1. S YSDXEN=$O(^YSD(627.8,"AX5",DFN,YSDXEL,-1))
  1. Q:YSDXEN<1
  1. S YSDXEG=$G(^YSD(627.8,YSDXEN,0))
  1. S YSGAFLD=$P(YSDXEG,U,3),YSGAFLC=$P(YSDXEG,U,4)
  1. S YSDXEG=$G(^YSD(627.8,YSDXEN,60))
  1. S YSGAFLN=$P(YSDXEG,U,3)
  1. S YSGAFER=$G(^YSD(627.8,YSDXEN,80,1,0))
  1. Q
  1. PRINT ;
  1. N %DT,DA,DIE,DIR,DIRUT,DLAYGO,DR,K,VA,VADM,X,X1,X2,Y,YSCLIN,YSCNAME,YSDA,YSDATE,YSDAYS,YSDD,YSDXEG,YSDXEL,YSDXEN,YSG,YSGAFLC,YSGAFLD,YSGAFLN,YSGC,YSGD,YSGN,YSGR,YSGT,YSLINE,YSN,YSONLY,YSOUT,YSPAGE,YSPTN,YSRULE,YSSTOP
  1. S YSDAYS=90
  1. D ONELOC^YSGAF1 Q:YSCLIN=""
  1. D DATE^YSGAF1 Q:YSDATE<1
  1. D ONLYREQ^YSGAF1 Q:YSONLY=""
  1. ;ASK DEVICE
  1. S %ZIS="QM"
  1. D ^%ZIS
  1. Q:$G(POP)
  1. I $D(IO("Q")) D Q
  1. .N ZTRTN,ZTDESC,ZTSAVE
  1. .S ZTRTN="QPRT^YSGAF"
  1. .S ZTDESC="YSGAF PRINT"
  1. .F ZZ="YSONLY","YSDAYS","YSCLIN","YSCNAME","YSDATE" S ZTSAVE(ZZ)=""
  1. .D ^%ZTLOAD
  1. .D HOME^%ZIS
  1. .Q
  1. U IO
  1. QPRT ;Queued Task Entry Point
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. D LP1^YSGAF1
  1. S YSPAGE=0 D TOP
  1. I '$D(^TMP("YSGAF",$J)) W !,"No appointments found" Q
  1. PR1 S YSN="",YSOUT=1 F S YSN=$O(^TMP("YSGAF",$J,"A",YSN)) Q:YSN="" S DFN=0 F S DFN=$O(^TMP("YSGAF",$J,"A",YSN,DFN)) Q:DFN'>0 D D:$Y+4>IOSL BOT Q:YSOUT<1
  1. . D CK,RULE
  1. .Q:('YSRULE)&(YSONLY)
  1. . D DEM^VADPT
  1. .W !,$E(YSN,1,25),?26,VA("BID"),?32,$S($L(YSGAFER):"Er",YSGAFLN:YSGAFLN,1:"--")," ",$S(YSGAFLD:$$FMTE^XLFDT(YSGAFLD,"5ZD"),1:" ")
  1. . W " "_$S(YSRULE:"**",1:" ")_"______ __________________"
  1. D ^%ZISC
  1. Q
  1. TOP ;print header
  1. S YSPAGE=YSPAGE+1
  1. I '$D(YSLINE) S YSLINE="",$P(YSLINE,"-",79)=""
  1. W @IOF,"GAF List Clinic: ",YSCNAME," **= > than ",YSDAYS," days"
  1. W !,"Appointment Date: ",$$FMTE^XLFDT(YSDATE,"5ZD")
  1. W ?32,"Last GAF New",?65,"page: ",YSPAGE
  1. W !?32,"GAF Date GAF Clinician",!,YSLINE
  1. Q
  1. BOT ;page end
  1. K DIR S YSOUT=1 I IOST'?1"C".E D TOP Q
  1. W !! S DIR(0)="E" D ^DIR
  1. S YSOUT=Y D:Y=1 TOP
  1. Q
  1. PTENT ;patient entry
  1. N %DT,DA,DIE,DIR,DIRUT,DLAYGO,DR,K,VA,VADM,X,X1,X2,Y,YSCLIN,YSCNAME,YSDA,YSDATE,YSDAYS,YSDD,YSDXEG,YSDXEL,YSDXEN,YSG,YSGAFLC,YSGAFLD,YSGAFLN,YSGC,YSGD,YSGN,YSGR,YSGT,YSLINE,YSN,YSONLY,YSOUT,YSPAGE,YSPTN,YSRULE,YSSTOP,YSGAFER
  1. W @IOF,"Global Assessment of functioning"
  1. F K DFN W ! D ^YSLRP Q:'$D(DFN) D DISP5,ADD5
  1. Q
  1. DISP5 ;display last axis5
  1. Q:'$D(DFN)
  1. D DEM^VADPT
  1. W !,VADM(1),?35,"SSN: xxx-xx-",VA("BID"),?55,"DOB: ",$P(VADM(3),U,2)
  1. DISP51 D CK
  1. I YSGAFLN D
  1. . W !?4,"Last GAF: ",YSGAFLN," on: "
  1. . S Y=YSGAFLD X ^DD("DD") W Y
  1. . W " by: ",$S(+$G(YSGAFLC):$P(^VA(200,YSGAFLC,0),U),1:"--> No provider entered for this GAF score")
  1. . I $L(YSGAFER)>1 W !,YSGAFER
  1. I YSGAFLN<1 W !?4,"no previous GAF"
  1. Q
  1. ADD5 ;add axis 5 dx
  1. W !!
  1. K DIR S DIR(0)="N^1:100:0",DIR("A")="GAF Score",DIR("?")="Enter the Global Assessment of Functioning : 1 to 100",DIR("??")="YS-GAF SCALE"
  1. ;I $D(YSGAFLN) S:YSGAFLN?1N.N DIR("B")=YSGAFLN
  1. D ^DIR S YSGN=Y S:X?1"^^".E YSOUT=1
  1. I $D(DIRUT) W !,"No GAF will be entered. Enter ^^ to end loop.",$C(7) Q
  1. K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="Diagnosis date/time: ",DIR("B")="NOW"
  1. D ^DIR S:Y>0 YSGD=Y
  1. I $D(DIRUT) W !,"No GAF will be entered",$C(7) Q
  1. K DIR,DIC S DIC="^VA(200,",DIC(0)="AEM",DIC("A")="Assessing Clinician: ",DIC("B")=$P(^VA(200,DUZ,0),U)
  1. D ^DIC K DIC S:Y>0 YSGC=+Y
  1. I Y<1 W !,"No GAF will be entered",$C(7) Q
  1. K DD,DO,DA,DINUM
  1. S X="NOW",%DT="TR" D ^%DT S X=Y
  1. S DIC="^YSD(627.8,",DIC(0)="L",DLAYGO=627.8 D FILE^DICN Q:Y'>0 S YSDA=+Y
  1. D PATSTAT^YSDX3B
  1. S DIE="^YSD(627.8,",DA=YSDA,DR=".02////"_DFN_";.03////"_YSGD_";.04////"_YSGC_";.05////"_DUZ_";65////"_YSGN_";66////"_YSSTAT
  1. L +^YSD(627.8,YSDA):9999 Q:'$T
  1. D ^DIE
  1. L -^YSD(627.8,YSDA)
  1. D EN^YSGAFOBX(YSDA)
  1. Q
  1. ;
  1. RET(YSX) ;This extrinsic returns the most recent GAF score, GAF
  1. ;diagnosis date and physician/provider performing the diagnosis,
  1. ;for the internal entry number given (via variable YSX.) If no
  1. ;GAF score data is on file for this internal entry number, -1 is
  1. ;returned.
  1. N YSHOLD
  1. S (YSHOLD)=""
  1. S YSHOLD=$O(^YSD(627.8,"C",YSX,""),-1)
  1. IF YSHOLD D
  1. .S YSZ=$P($G(^YSD(627.8,YSHOLD,60)),"^",3)
  1. .S YSZ=YSZ_"^"_$P($G(^YSD(627.8,YSHOLD,0)),"^",3)
  1. .S YSZ=YSZ_"^"_$P($G(^YSD(627.8,YSHOLD,0)),"^",4)
  1. ELSE S YSZ=-1
  1. Q YSZ
  1. ;
  1. UPD(YSPN,YSGN,YSGD,YSGC,YSPT) ;Update GAF information
  1. ; YSPN - Patient Name
  1. ; YSGN - GAF Score (Axis 5)
  1. ; YSGD - Date/Time of Diagnosis
  1. ; YSGC - Diagnosis By
  1. ; YSPT - Patient Type ('I'npatient or 'O'utpatient)
  1. S YSERR=0
  1. I '$G(YSPN) D
  1. .W !," The Patient IEN is required!!!",!
  1. .S YSERR=1
  1. .Q
  1. ;
  1. I '$G(YSGN) D
  1. .W !," The GAF Score is required!!!",!
  1. .S YSERR=1
  1. .Q
  1. ;
  1. I '$G(YSGD) D
  1. .W " The Observation Date/Time is required!!!",!
  1. .S YSERR=1
  1. .Q
  1. ;
  1. I '$G(YSGC) D
  1. .W " The Provider is required!!!",!
  1. .S YSERR=1
  1. .Q
  1. ;
  1. QUIT:YSERR ;---->
  1. ;
  1. K DD,DO,DA,DINUM
  1. S DLAYGO=627.8,X="NOW",%DT="TR" D ^%DT S X=Y
  1. S DIC="^YSD(627.8,",DIC(0)="L"
  1. D FILE^DICN Q:Y'>0 S YSDA=+Y
  1. S DFN=+YSPN
  1. D PATSTAT^YSDX3B
  1. S DIE="^YSD(627.8,",DA=YSDA
  1. S DR=".02////"_YSPN_";.03////"_YSGD_";.04////"_YSGC_";.05////"_DUZ
  1. S DR=DR_";65////"_YSGN_";66////"_YSSTAT
  1. L +^YSD(627.8,YSDA):9999 Q:'$T
  1. D ^DIE
  1. L -^YSD(627.8,YSDA)
  1. D EN^YSGAFOBX(YSDA)
  1. K %DT,DA,DIC,DIE,DLAYGO,DR,X,Y,YSDA,YSPN,YSGN,YSGD,YSGC,YSSTAT
  1. Q