source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASSEL.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1YSASSEL ;ALB/ASF-ASI SELECTOR ;4/16/98 16:42
2 ;;5.01;MENTAL HEALTH;**24,30,38,76**;Dec 30, 1994
3ADDEDIT ;
4 K ^TMP($J,"YSASI")
5 D PT
6 Q:YSASPIEN<1
7 I '$D(^YSTX(604,"C",YSASPIEN)) D ASKNEW Q
8 W @IOF,?25,"***** Add - Edit *****"
9 D TLD,TLP
10 W !
11 S DIR(0)=DIR(0)_"N:NEW",DIR("A")="Select number or NEW: " D ^DIR K DIR
12 I Y?1N.N D Q
13 .S YSASSIEN=+^TMP($J,"YSASI",Y)
14 . I $P(^TMP($J,"YSASI",Y),U,5)=1 W !,"This ASI has already been signed. You may no longer edit it!",$C(7) Q
15 . D OLCL
16 . Q
17 Q:Y'="N"
18 K DIR S DIR(0)="SA^1:Full Intake;2:Lite Intake;3:Followup ASI",DIR("A")="Select Type: ",DIR("B")="Followup" D ^DIR K DIR Q:$D(DIRUT) S YSASTYP=+Y
19 D AA^YSASA2(YSASPIEN,YSASTYP),OLCL
20 Q
21OLCL ;online vs clerk
22 D SCREENH^YSASA2
23 K DIR S Y=0,DIR(0)="SA^1:On-line;2:Clerk entry",DIR("A")="Select Entry option: "
24 S DIR("B")=$S($P(^YSTX(604.8,1,0),U,3)="C":"Clerk",1:"On-line")
25 D:$L(IOXY) ^DIR Q:$D(DIRUT)
26 L +^YSTX(604,YSASPIEN):9999 Q:'$T
27 D MAIN^YSASOL(YSASPIEN,YSASSIEN):Y=1,MAIN^YSASA2(YSASPIEN,YSASSIEN):Y=2
28 L -^YSTX(604,YSASPIEN)
29 Q
30SELPRINT ;
31 K ^TMP($J,"YSASI")
32 D PT
33 Q:YSASPIEN<1
34 W @IOF,?25,"***** Item Report ****"
35 D TLD,TLP
36 W !
37 S DIR("A")="Select ASI number: " D ^DIR K DIR W !,X," ",Y H 2
38 I Y?1N.N W $C(7) S YSASSIEN=+^TMP($J,"YSASI",Y) D EN1^YSASPRT(YSASSIEN)
39 Q
40NARR ;narrative output
41 K ^TMP($J,"YSASI")
42 D PT
43 Q:YSASPIEN<1
44 W @IOF,?25,"***** Narrative Report ****"
45 D TLD,TLP
46 W !
47 S DIR("A")="Select ASI number: " D ^DIR K DIR
48 Q:Y'?1N.N
49 S YSASSIEN=+^TMP($J,"YSASI",Y),YSASCL=$P(^YSTX(604,YSASSIEN,0),U,4)
50 ;I YSASCL=3 W !!,"Narrative Report not available for follow ups. Please use Item Report",$C(7) Q
51 D EN1^YSASNAR(YSASSIEN)
52 D ^%ZISC
53 Q
54ASKNEW ;
55 W !,"There are no previous ASI's on file.",!
56 S DIR("A")="Do you wish to add a new ASI for this patient"
57 S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR Q:Y'=1
58 K DIR S DIR(0)="SA^1:Full AS1;2:Lite ASI;3:Followup ASI",DIR("A")="Select ASI Type: "
59 S DIR("B")=$S($P(^YSTX(604.8,1,0),U,2)="L":"Lite",1:"Full") D ^DIR K DIR Q:$D(DIRUT) S YSASTYP=+Y
60 I YSASTYP=3 S DIR("A")="No previous ASIs are on file for this patient. Are you sure you want to enter a FOLLOWUP",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR Q:Y'=1
61 D AA^YSASA2(YSASPIEN,YSASTYP),OLCL
62 Q
63PT ;patient lookup
64 S DIC="^DPT(",DIC(0)="AEMQ"
65 D ^DIC
66 S YSASPIEN=+Y
67 Q
68TLD ;load ASI list
69 K ^TMP($J,"YSASI")
70 K DIR S DIR(0)="" ;"SA^"
71 S YSASIEN=0,YSASC=0
72 F S YSASIEN=$O(^YSTX(604,"C",YSASPIEN,YSASIEN)) Q:YSASIEN'>0 D
73 . S YSASC=YSASC+1
74 . S YSASCL=$$GET1^DIQ(604,YSASIEN_",",.04)
75 . S YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05)
76 . S YSASINT=$$GET1^DIQ(604,YSASIEN_",",.09)
77 . S YSASIG=$$GET1^DIQ(604,YSASIEN_",",.51,"I")
78 . S ^TMP($J,"YSASI",YSASC)=YSASIEN_U_YSASDT_U_YSASCL_U_YSASINT_U_YSASIG
79 . S DIR(0)=YSASC_":"_YSASDT_";"_$P(DIR(0),";",1,20)
80 S DIR(0)="SA^"_DIR(0) ;
81 Q
82TLP ; print list
83 Q:'$D(^TMP($J,"YSASI"))
84 S YSL="",$P(YSL,"_",79)=""
85 S DFN=YSASPIEN D DEM^VADPT
86 ;W @IOF
87 W !,VADM(1)," ",$P(VADM(2),U,2),?45,"Addiction Severity Index History",!
88 W " #",?7,"Date",?18,"Class",?30,"Interviewer",!,YSL,!
89 S YSASC=0
90 F S YSASC=$O(^TMP($J,"YSASI",YSASC)) Q:YSASC'>0 D
91 . S YSASG=^TMP($J,"YSASI",YSASC)
92 . W !,$J(YSASC,3)," "
93 . ;W $P(YSASG,U,2)
94 . W $$FMTE^XLFDT($P(YSASG,U,2),"5ZD")
95 . W ?18,$P(YSASG,U,3)
96 . W ?28,$P(YSASG,U,4)
97 . W ?55,$S($P(YSASG,U,5)=1:"Signed",1:"## Not Signed ##")
98 ;
99 Q
100BROWSE ;
101 D WP^DDBR(604.68,YSA_",",1,"R",YSTITLE)
102 Q
103ASICHECK N YSTITLE,YSA S YSTITLE="ASI CHECKING MANUAL",YSA=$O(^YSTX(604.68,"B",YSTITLE,0)) Q:YSA'>1 D BROWSE Q
104ASISHORT N YSTITLE,YSA S YSTITLE="ASI SHORT GUIDE",YSA=$O(^YSTX(604.68,"B",YSTITLE,0)) Q:YSA'>1 D BROWSE Q
105ASIQE N YSTITLE,YSA S YSTITLE="COMMON QUESTIONS AND ERRORS",YSA=$O(^YSTX(604.68,"B",YSTITLE,0)) Q:YSA'>1 D BROWSE Q
106ASIHOLL N YSTITLE,YSA S YSTITLE="HOLLINGSHEAD CATEGORIES",YSA=$O(^YSTX(604.68,"B",YSTITLE,0)) Q:YSA'>1 D BROWSE Q
107ASIDRUG N YSTITLE,YSA S YSTITLE="LIST OF COMMONLY USED DRUGS",YSA=$O(^YSTX(604.68,"B",YSTITLE,0)) Q:YSA'>1 D BROWSE Q
108ASIUSER N YSTITLE,YSA S YSTITLE="ASI USER GUIDE",YSA=$O(^YSTX(604.68,"B",YSTITLE,0)) Q:YSA'>1 D BROWSE Q
Note: See TracBrowser for help on using the repository browser.