122 lines
4.4 KiB
Mathematica
122 lines
4.4 KiB
Mathematica
YSASA2 ;ASF/ALB-ASI QUICK ENTRY ;3/19/98 15:08
|
|
;;5.01;MENTAL HEALTH;**24,30,32,38**;Dec 30, 1994
|
|
Q
|
|
AA(YSASPIEN,YSASTYP) ;Add NEW RECORD
|
|
Q:$G(YSASPIEN)'>0
|
|
Q:$G(YSASTYP)'>0
|
|
N YSASGE,YSASRACE,YSASREL,YSASU0,YSASU1,YSASNEW,YSASNM
|
|
N YSASSEX,YSASG0,YSASG1,YSASHL,YSASI0,YSASI1,YSASLT,YSASVL,YSASTT,YSASTRC
|
|
N YSASBLC,YSASTLC,YSASTRC,YSASDFLT
|
|
N YSASBT,YSASBRC
|
|
N YSASN ;age and name
|
|
N IOHG,IOINHI,IOINORM,IOUOFF,IOUON
|
|
N DIC,DA,X,Y,DDSFILE,DR,DLAYGO,DIERR
|
|
S Y=YSASPIEN,Y(0)=^DPT(Y,0)
|
|
W !!,"...reading Patient information..."
|
|
S YSASRACE=$$RACE^YSASLIB($P(Y(0),"^",6)),YSASREL=$$REL^YSASLIB($P(Y(0),"^",8)),YSASSEX=$P(Y(0),"^",2)
|
|
S YSASGE=$$GET1^DIQ(2,+Y_",","AGE"),YSASNM=$P(Y(0),U)
|
|
W !,"...creating new ASI record..."
|
|
S DLAYGO=604
|
|
S DIC="^YSTX(604,",DIC(0)="L",X="NEW"
|
|
D ^DIC
|
|
Q:Y'>0
|
|
S YSASSIEN=+Y,YSASNEW=$P(Y,"^",3)=1
|
|
N DIE,DA,DR,X,Y,YSAS,YSASF,YSASV,YSAS033,YSASC,YSASDF,YSASLR
|
|
S DIE=DIC,DA=YSASSIEN
|
|
S DR=".02///`"_YSASPIEN
|
|
S DR=DR_";.04///"_YSASTYP
|
|
S DR=DR_";.05///NOW;.09////"_DUZ ;ASF 6/24
|
|
S:YSASRACE]"" DR=DR_";.16///"_YSASRACE
|
|
S:YSASREL]"" DR=DR_";.17///"_YSASREL
|
|
D ^DIE
|
|
;
|
|
Q
|
|
MAIN(YSASPIEN,YSASSIEN) ;
|
|
Q:$G(YSASSIEN)'>0
|
|
Q:$G(YSASPIEN)'>0
|
|
D SCREENH
|
|
S YSIENS=YSASSIEN_","
|
|
S YSASTYP=$$GET1^DIQ(604,YSIENS,"CLASS")
|
|
S YSGP=$S(YSASTYP?1"L".E:5,YSASTYP?1"FO".E:6,1:4)
|
|
S DFN=YSASPIEN D DEM^VADPT S YSHDR1=VADM(1)_" "_$P(VADM(2),U,2) D KVAR^VADPT
|
|
S YSHDR2="Addiction Severity Index "_YSASTYP
|
|
W @IOF,YSHDR1,?45,YSASI1,YSHDR2,YSASI0,!
|
|
S YSFILE=604,YSFLAG="EF"
|
|
S YSFDA="^TMP($J,""YSASI"")"
|
|
K ^TMP($J,"YSASI")
|
|
S YSDFLAG=$$GET1^DIQ(604.8,"1,",.04)
|
|
S YSEFLAG=$$GET1^DIQ(604.8,"1,",.07)
|
|
S YSN=0,YSV=""
|
|
LOOP ;
|
|
F S YSN=$O(^YSTX(604.66,YSN)) Q:YSN'>0!(YSV="^") S YSENDLP=0 D L3
|
|
W !
|
|
K DIR S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Save editing session" D ^DIR K DIR
|
|
Q:'Y
|
|
D FILE^DIE("K","^TMP($J,""YSASI"")")
|
|
WP ;
|
|
K DIRUT,DIR F Q:$D(DIRUT) D
|
|
. W !?10,"*** Comments ***",!,"1. General Info",?20,"2. Medical",?40,"3. Employment",?60,"4. Drug/Alcohol"
|
|
. W !,"5. Legal",?20,"6. Family hx",?40,"7. Social",?60,"8. Psychiatric"
|
|
. W !,"9. Spiritual",?19,"10. Leisure",!
|
|
. K DIR S DIR("A")="Enter Comment for? ",DIR(0)="NO^1:10:0" D ^DIR
|
|
. Q:$D(DIRUT)
|
|
. S DR=$S(Y=1:.6,Y=2:8.5,Y=3:9.5,Y=4:10.5,Y=5:14.5,Y=6:16.5,Y=7:18.5,Y=8:19.5,Y=9:188,Y=10:187)
|
|
. S DA=YSASSIEN,DIE="^YSTX(604,"
|
|
. D ^DIE
|
|
. Q
|
|
;
|
|
D EN^YSASSN(YSASSIEN)
|
|
Q
|
|
L3 ;
|
|
S YSG=^YSTX(604.66,YSN,0),YSFIELD=+$P(YSG,U,3),YSQ=$P(YSG,U,2),YSDEF=$P(YSG,U,7),YSASENT=$P(YSG,U,9)
|
|
S YSASEX=$G(^YSTX(604.66,YSN,1))
|
|
Q:$P(YSG,U,YSGP)=""
|
|
W:$Y+4>IOSL @IOF,YSHDR1,?45,YSASI1,YSHDR2,YSASI0,!
|
|
Q:YSENDLP ;quit if executable sets flag
|
|
I YSASENT'="" W YSASI1 X YSASENT W YSASI0
|
|
L4 ;No form feed
|
|
D FDAGET S YSP=Y
|
|
S:YSP=""!(YSP="^") YSP=$$GET1^DIQ(604,YSIENS,YSFIELD)
|
|
I YSP="",YSDFLAG="YES" S YSP=YSDEF ; SET DEFAULT IF FLAG SET
|
|
W !,$S($P(^YSTX(604.66,YSN,0),U,10)=1&(YSASTYP="FOLLOWUP"):"* ",1:""),YSQ,$S(YSP="":": ",1:": "_YSP_" // ")
|
|
R YSV:DTIME S:'$T YSV="^"
|
|
S:YSV="" YSV=YSP
|
|
Q:YSV=""!(YSV="^")
|
|
I YSV?1"^"1A1N.E D Q:YSNN1'=0
|
|
. I YSV?1"^"1L.N S YSV="^"_$C($A(YSV,2)-32)_$E(YSV,3,9)
|
|
. S (YSNN,YSNN1)=0
|
|
. S YSNN=$O(^YSTX(604.66,"C",$E(YSV,2,9)))
|
|
. Q:$E(YSNN,1,$L(YSV)-1)'=$E(YSV,2,9)
|
|
. S:$L(YSNN) YSNN1=$O(^YSTX(604.66,"C",YSNN,-1))
|
|
. S:YSNN1 YSN=YSNN1-.01
|
|
;
|
|
I YSV?1"?".E W YSASI1 D W YSASI0 K YSATRIB G L4
|
|
. S YSATRIB=$P(^DD(604,YSFIELD,0),U,3) ;$$GET1^DID(YSFILE,YSFIELD,"","POINTER")
|
|
. I YSATRIB?1"YSTX".E S DIC="^"_YSATRIB,DIC(0)="FIS",D="B" D DQ^DICQ K DIC,DIE,DID,D,DIX,DO
|
|
. I YSATRIB'?1"YSTX".E D HELP^DIE(YSFILE,"",YSFIELD,"?",YSFDA),MSG^DIALOG("WH","","","",YSFDA)
|
|
. Q
|
|
S:YSV?1N.N YSV=+YSV ;ASF 5/16
|
|
D VAL
|
|
I YSA="^" W $C(7) D HELP^DIE(YSFILE,"",YSFIELD,"?",YSFDA),MSG^DIALOG("WH","","","",YSFDA) G L4
|
|
W ?$X+3,YSA(0)
|
|
I YSEFLAG="YES" X YSASEX ; branch if parameters allowed
|
|
Q
|
|
VAL ;
|
|
D VAL^DIE(YSFILE,YSIENS,YSFIELD,YSFLAG,YSV,.YSA,YSFDA,"^TMP($J,""YSASERR"")")
|
|
Q
|
|
FDAGET ;
|
|
S Y=$$VALUE1^DILF(YSFILE,YSFIELD,YSFDA)
|
|
S:Y'=""&(Y'="^") Y=$$EXTERNAL^DILFD(YSFILE,YSFIELD,"",Y)
|
|
Q
|
|
SCREENH ;
|
|
D:'$D(IOST) HOME^%ZIS
|
|
;D GSET^%ZISS
|
|
;S YSASVL=IOG1_IOVL_IOG0,YSASLT=IOG1_IOLT_IOG0,YSASG1=IOG1,YSASG0=IOG0
|
|
;S YSASHL=IOHL,YSASTT=$G(IOTT),YSASTRC=IOTRC,YSASBT=$G(IOBT),YSASBRC=$G(IOBRC)
|
|
;S YSASBLC=$G(IOBLC),YSASTLC=$G(IOTLC),YSASTRC=$G(IOTRC)
|
|
;D GKILL^%ZISS
|
|
S X="IOUON;IOUOFF;IOINHI;IOINORM;IOBON;IOBOFF;IORVON;IORVOFF;IOHOME;IOEDEOP"
|
|
D ENDR^%ZISS
|
|
S YSASU0=$G(IOUOFF),YSASU1=$G(IOUON),YSASI0=$G(IOINORM),YSASI1=$G(IOINHI),YSASRV1=$G(IORVON),YSASRV0=$G(IORVOFF)
|
|
S YSASB1=$G(IOBON),YSASB0=$G(IOBOFF)
|