source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASA2.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1YSASA2 ;ASF/ALB-ASI QUICK ENTRY ;3/19/98 15:08
2 ;;5.01;MENTAL HEALTH;**24,30,32,38**;Dec 30, 1994
3 Q
4AA(YSASPIEN,YSASTYP) ;Add NEW RECORD
5 Q:$G(YSASPIEN)'>0
6 Q:$G(YSASTYP)'>0
7 N YSASGE,YSASRACE,YSASREL,YSASU0,YSASU1,YSASNEW,YSASNM
8 N YSASSEX,YSASG0,YSASG1,YSASHL,YSASI0,YSASI1,YSASLT,YSASVL,YSASTT,YSASTRC
9 N YSASBLC,YSASTLC,YSASTRC,YSASDFLT
10 N YSASBT,YSASBRC
11 N YSASN ;age and name
12 N IOHG,IOINHI,IOINORM,IOUOFF,IOUON
13 N DIC,DA,X,Y,DDSFILE,DR,DLAYGO,DIERR
14 S Y=YSASPIEN,Y(0)=^DPT(Y,0)
15 W !!,"...reading Patient information..."
16 S YSASRACE=$$RACE^YSASLIB($P(Y(0),"^",6)),YSASREL=$$REL^YSASLIB($P(Y(0),"^",8)),YSASSEX=$P(Y(0),"^",2)
17 S YSASGE=$$GET1^DIQ(2,+Y_",","AGE"),YSASNM=$P(Y(0),U)
18 W !,"...creating new ASI record..."
19 S DLAYGO=604
20 S DIC="^YSTX(604,",DIC(0)="L",X="NEW"
21 D ^DIC
22 Q:Y'>0
23 S YSASSIEN=+Y,YSASNEW=$P(Y,"^",3)=1
24 N DIE,DA,DR,X,Y,YSAS,YSASF,YSASV,YSAS033,YSASC,YSASDF,YSASLR
25 S DIE=DIC,DA=YSASSIEN
26 S DR=".02///`"_YSASPIEN
27 S DR=DR_";.04///"_YSASTYP
28 S DR=DR_";.05///NOW;.09////"_DUZ ;ASF 6/24
29 S:YSASRACE]"" DR=DR_";.16///"_YSASRACE
30 S:YSASREL]"" DR=DR_";.17///"_YSASREL
31 D ^DIE
32 ;
33 Q
34MAIN(YSASPIEN,YSASSIEN) ;
35 Q:$G(YSASSIEN)'>0
36 Q:$G(YSASPIEN)'>0
37 D SCREENH
38 S YSIENS=YSASSIEN_","
39 S YSASTYP=$$GET1^DIQ(604,YSIENS,"CLASS")
40 S YSGP=$S(YSASTYP?1"L".E:5,YSASTYP?1"FO".E:6,1:4)
41 S DFN=YSASPIEN D DEM^VADPT S YSHDR1=VADM(1)_" "_$P(VADM(2),U,2) D KVAR^VADPT
42 S YSHDR2="Addiction Severity Index "_YSASTYP
43 W @IOF,YSHDR1,?45,YSASI1,YSHDR2,YSASI0,!
44 S YSFILE=604,YSFLAG="EF"
45 S YSFDA="^TMP($J,""YSASI"")"
46 K ^TMP($J,"YSASI")
47 S YSDFLAG=$$GET1^DIQ(604.8,"1,",.04)
48 S YSEFLAG=$$GET1^DIQ(604.8,"1,",.07)
49 S YSN=0,YSV=""
50LOOP ;
51 F S YSN=$O(^YSTX(604.66,YSN)) Q:YSN'>0!(YSV="^") S YSENDLP=0 D L3
52 W !
53 K DIR S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Save editing session" D ^DIR K DIR
54 Q:'Y
55 D FILE^DIE("K","^TMP($J,""YSASI"")")
56WP ;
57 K DIRUT,DIR F Q:$D(DIRUT) D
58 . W !?10,"*** Comments ***",!,"1. General Info",?20,"2. Medical",?40,"3. Employment",?60,"4. Drug/Alcohol"
59 . W !,"5. Legal",?20,"6. Family hx",?40,"7. Social",?60,"8. Psychiatric"
60 . W !,"9. Spiritual",?19,"10. Leisure",!
61 . K DIR S DIR("A")="Enter Comment for? ",DIR(0)="NO^1:10:0" D ^DIR
62 . Q:$D(DIRUT)
63 . 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)
64 . S DA=YSASSIEN,DIE="^YSTX(604,"
65 . D ^DIE
66 . Q
67 ;
68 D EN^YSASSN(YSASSIEN)
69 Q
70L3 ;
71 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)
72 S YSASEX=$G(^YSTX(604.66,YSN,1))
73 Q:$P(YSG,U,YSGP)=""
74 W:$Y+4>IOSL @IOF,YSHDR1,?45,YSASI1,YSHDR2,YSASI0,!
75 Q:YSENDLP ;quit if executable sets flag
76 I YSASENT'="" W YSASI1 X YSASENT W YSASI0
77L4 ;No form feed
78 D FDAGET S YSP=Y
79 S:YSP=""!(YSP="^") YSP=$$GET1^DIQ(604,YSIENS,YSFIELD)
80 I YSP="",YSDFLAG="YES" S YSP=YSDEF ; SET DEFAULT IF FLAG SET
81 W !,$S($P(^YSTX(604.66,YSN,0),U,10)=1&(YSASTYP="FOLLOWUP"):"* ",1:""),YSQ,$S(YSP="":": ",1:": "_YSP_" // ")
82 R YSV:DTIME S:'$T YSV="^"
83 S:YSV="" YSV=YSP
84 Q:YSV=""!(YSV="^")
85 I YSV?1"^"1A1N.E D Q:YSNN1'=0
86 . I YSV?1"^"1L.N S YSV="^"_$C($A(YSV,2)-32)_$E(YSV,3,9)
87 . S (YSNN,YSNN1)=0
88 . S YSNN=$O(^YSTX(604.66,"C",$E(YSV,2,9)))
89 . Q:$E(YSNN,1,$L(YSV)-1)'=$E(YSV,2,9)
90 . S:$L(YSNN) YSNN1=$O(^YSTX(604.66,"C",YSNN,-1))
91 . S:YSNN1 YSN=YSNN1-.01
92 ;
93 I YSV?1"?".E W YSASI1 D W YSASI0 K YSATRIB G L4
94 . S YSATRIB=$P(^DD(604,YSFIELD,0),U,3) ;$$GET1^DID(YSFILE,YSFIELD,"","POINTER")
95 . I YSATRIB?1"YSTX".E S DIC="^"_YSATRIB,DIC(0)="FIS",D="B" D DQ^DICQ K DIC,DIE,DID,D,DIX,DO
96 . I YSATRIB'?1"YSTX".E D HELP^DIE(YSFILE,"",YSFIELD,"?",YSFDA),MSG^DIALOG("WH","","","",YSFDA)
97 . Q
98 S:YSV?1N.N YSV=+YSV ;ASF 5/16
99 D VAL
100 I YSA="^" W $C(7) D HELP^DIE(YSFILE,"",YSFIELD,"?",YSFDA),MSG^DIALOG("WH","","","",YSFDA) G L4
101 W ?$X+3,YSA(0)
102 I YSEFLAG="YES" X YSASEX ; branch if parameters allowed
103 Q
104VAL ;
105 D VAL^DIE(YSFILE,YSIENS,YSFIELD,YSFLAG,YSV,.YSA,YSFDA,"^TMP($J,""YSASERR"")")
106 Q
107FDAGET ;
108 S Y=$$VALUE1^DILF(YSFILE,YSFIELD,YSFDA)
109 S:Y'=""&(Y'="^") Y=$$EXTERNAL^DILFD(YSFILE,YSFIELD,"",Y)
110 Q
111SCREENH ;
112 D:'$D(IOST) HOME^%ZIS
113 ;D GSET^%ZISS
114 ;S YSASVL=IOG1_IOVL_IOG0,YSASLT=IOG1_IOLT_IOG0,YSASG1=IOG1,YSASG0=IOG0
115 ;S YSASHL=IOHL,YSASTT=$G(IOTT),YSASTRC=IOTRC,YSASBT=$G(IOBT),YSASBRC=$G(IOBRC)
116 ;S YSASBLC=$G(IOBLC),YSASTLC=$G(IOTLC),YSASTRC=$G(IOTRC)
117 ;D GKILL^%ZISS
118 S X="IOUON;IOUOFF;IOINHI;IOINORM;IOBON;IOBOFF;IORVON;IORVOFF;IOHOME;IOEDEOP"
119 D ENDR^%ZISS
120 S YSASU0=$G(IOUOFF),YSASU1=$G(IOUON),YSASI0=$G(IOINORM),YSASI1=$G(IOINHI),YSASRV1=$G(IORVON),YSASRV0=$G(IORVOFF)
121 S YSASB1=$G(IOBON),YSASB0=$G(IOBOFF)
Note: See TracBrowser for help on using the repository browser.