source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASFM.m@ 1452

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1YSASFM ;ASF/ALB- FILEMAN ASI REPORTS ;4/9/98 13:45
2 ;;5.01;MENTAL HEALTH;**24,30,32,37,38,55,76**;Dec 30, 1994
3 Q
4INTDATE ;interviewer by date
5 N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
6 D TOP("ASI Report by Interviewer")
7 S DIC="^YSTX(604,",L=0,FLDS="!.02,.0209,.05,.04",BY="+.09,.05",DIPCRIT=1 D EN1^DIP
8 Q
9SINGLEI ;single interviewer
10 N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
11 D TOP("ASI Report by Single Interviewer")
12 S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Select ASI Interviewer: " D ^DIC Q:Y'>0 S YSINT=$P(Y,U,2)
13 S DIC="^YSTX(604,",L=0,FLDS="!.02,.0209,.05,.04",BY="+.09,.05",DIPCRIT=1
14 S FR(1)=YSINT,TO(1)=YSINT,FR(2)="?",TO(2)="?"
15 D EN1^DIP
16 Q
17ALPHADT ; Name by date
18 N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
19 D TOP("ASI Report by Patient Name")
20 S DIC="^YSTX(604,",L=0,FLDS="!.02;L30;C1,.0209;L10,.05;L12,.09;L20"
21 S BY=".02,.05",DIPCRIT=1 D EN1^DIP
22 Q
23UNSIGN ;incomplete ASIs
24 N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
25 D TOP("Incomplete ASI Report")
26 S DIC="^YSTX(604,",L=0,FLDS="!.02;L30;C1,.0209;L10,.05;L12,.09;L20"
27 S BY="@.51,.05",FR="@,?",TO="@,?",DIPCRIT=1,DHD="Incomplete ASI Administrations" D EN1^DIP
28 Q
29DTORD ;date sort
30 N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
31 D TOP("ASI Report by Interview Date")
32 S DIC="^YSTX(604,",L=0,FLDS="!.02;L30;C1,.0209;L10,.05;L12,.09;L20"
33 S BY=".05,.02",DIPCRIT=1 D EN1^DIP
34 Q
35SSNORD ;order by SSN
36 N DIE,DIC,DR,DA,FLDS,L,TO,FR,BY,DHD,DIPCRIT,X,Y,YSINT
37 D TOP("ASI Report by Social Security Number")
38 S DIC="^YSTX(604,",L=0,FLDS="!.0209;L10;C1,.02;L30,.05;L12,.04;L5,.51;L3"
39 S BY=".0209,.05",FR=",?",TO=FR,DIPCRIT=1 D EN1^DIP
40 Q
41TOP(X) ;HEADING
42 W @IOF,!?15,"***** ",X," *****",!,"please queue all reports",!
43 Q
44PARAM ;edit ASI Parameters file
45 W @IOF,!,"***** Edit ASI Site Parameters *****",!
46 S DIE="^YSTX(604.8,",DA=1,DR=".02:2"
47 L +^YSTX(604.8,DA):9999 Q:'$T
48 D ^DIE
49 L -^YSTX(604.8,DA)
50 Q
51PROGRAM ;activate/inactivate programs
52 N DIC,DIE,DR,DA,X,Y
53 S DIC="^YSTX(604.26,",DIC(0)="AEQ" D ^DIC Q:Y'>0
54 S DA=+Y,DIE=DIC,DR=3
55 L +^YSTX(604.26,DA):9999 Q:'$T
56 D ^DIE
57 L -^YSTX(604.26,DA)
58 G PROGRAM
59 ;
60CLEAR ; delete UNSIGNED ASI
61 K ^TMP($J,"YSASI")
62 D PT^YSASSEL
63 Q:YSASPIEN<1
64 W @IOF,?25,"***** ASI Deletion Utility ****"
65 D TLD^YSASSEL,TLP^YSASSEL
66 W !
67 S DIR("A")="Select ASI number: " D ^DIR K DIR
68 Q:Y'?1N.N
69 S YSASSIEN=+^TMP($J,"YSASI",Y),YSASIG=$P(^TMP($J,"YSASI",Y),U,5)
70 I YSASIG W !!,"This ASI is signed and deletion is not permitted!",$C(7) Q
71 K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to delete this ASI",DIR("B")="N" D ^DIR
72 Q:Y'=1
73 S DA=YSASSIEN,DIK="^YSTX(604," D ^DIK
74 W !,"ASI deleted...."
75 Q
76DEFED ;default editor
77 N YSASIEN,DIC,DIE,DA,YSFIELD,YSFDA
78 W @IOF,?10,"*** ASI Default Editor ***",!
79DEFED1 S DIC("A")="Select ASI Item: ",DIC="^YSTX(604.66,",DIC(0)="AEQM" D ^DIC
80 Q:Y'>0
81 S YSASIEN=+Y,YSFIELD=$P(^YSTX(604.66,YSASIEN,0),U,3)
82 S YSFDA="^TMP($J,""YSASI"")"
83 W !
84 D HELP^DIE(604,"",YSFIELD,"A",YSFDA),MSG^DIALOG("WH","","","",YSFDA)
85 S DIE="^YSTX(604.66,",DA=YSASIEN,DR=6
86 L +^YSTX(604.66,DA):9999 Q:'$T
87 D ^DIE
88 L -^YSTX(604.66,DA)
89 G DEFED1
Note: See TracBrowser for help on using the repository browser.