source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOEDT0.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1QAOEDT0 ;HISC/DAD-CLINICAL, PEER, & MANAGER REVIEW ;6/24/93 15:34
2 ;;3.0;Occurrence Screen;;09/14/1993
3ASKDFN ;
4 D HOME^%ZIS
5 S QALIMIT="I $P(^(0),""^"",11)'>0",QAOSPROG="EN1^QAOEDT0" D EN2^QAOEDT
6 K %,D,D0,D1,DA,DD,DIC,DIE,DINUM,DO,DR,DZ,QAOS,QAOSD0,QAOSD1,QAOSD2
7 K QAOSDATA,QAOSDATE,QAOSDFN,QAOSFIND,QAOSFOND,QAOSLEVL,QAOSLVNO
8 K QAOSMDUE,QAOSNEWF,QAOSPDUE,QAOSQUIT,QAOSSCRN,QAOSWARD,QAOSWHAT
9 K QAOSX,QAOSZERO,SAVEX,SAVEY,UNDL,X,Y,QA,QAOSFDSP,QAOSFIND,QAUDIT
10 K QAOSLOC,QAOSMGMT,QAOSREVR,QALIMIT,QAOSONE,QAOSPROG,QAOFIELD,QAOSNODE
11 K QAOSSERV,QAOSUBDD
12 Q
13EN1 ;
14 ; *** FINAL DISPOSITION ACTIONS AND FINDINGS
15 S (QAOSQUIT,QAOSFDSP)=0,QAOSFDSP("A")="^1^1.1^",QAOSFDSP("F")="^1^3^11^"
16 S QAOSWHAT="REVIEWED" D ENDISP^QAOUTL0
17 K DR S DIE="^QA(741,",DR="19;5;6;7;8;9",DA=QAOSD0
18 D ^DIE I $D(Y) S QAOSQUIT=1 D AUDIT("e","CLINICAL/PEER/MANAGEMENT REVIEW") G DONE
19 W !!?5,"Select CLINICAL, PEER, or MANAGEMENT review level."
20 W !?5,"Only one CLINICAL review level may be entered."
21 D ASKLEVL
22 I QAOSQUIT D AUDIT("e","CLINICAL/PEER/MANAGEMENT REVIEW") G DONE
23ASKDISP ;
24 S QAOSMGMT=+$O(^QA(741.2,"C",3,0))
25 S QAOSFDSP=$S($O(^QA(741,QAOSD0,"REVR","B",QAOSMGMT,0)):1,1:QAOSFDSP)
26 G:QAOSFDSP'>0 DONE
27 W !!?5,"Do you wish to enter a FINAL DISPOSITION"
28 S %=2 D YN^DICN G:(%=-1)!(%=2) DONE
29 I '% D G ASKDISP
30 . W !!?10,"Enter Y(es) to edit the FINAL DISPOSITION DATE and FINAL"
31 . W !?10,"DISPOSITION REACHED BY data."
32 . W !?10,"Enter N(o) to skip the FINAL DISPOSITION and select the next patient."
33 . Q
34 S QAOSWHAT="CLOSED OUT" D ENDISP^QAOUTL0
35 K DR S DIE="^QA(741,",DR="14//TODAY;16;11//CLOSED",DA=QAOSD0
36 D ^DIE I $D(Y) S QAOSQUIT=1
37 D AUDIT("c","CLOSE A RECORD")
38DONE ;
39 Q
40ASKLEVL ;
41 R !!,"Select REVIEW LEVEL: ",X:DTIME S:'$T X="^"
42 I "^"[$E(X) S QAOSQUIT=($E(X)="^") Q
43 I $E(X)="?" D
44 . N X K DIC S DIC="^QA(741,"_QAOSD0_",""REVR"",",DIC(0)="MQZ"
45 . S D="B",DZ="??",(D0,DA,DA(1))=QAOSD0
46 . W !!,"Already existing reviews for this occurrence:"
47 . S QAOSDATA=$O(^QA(741,QAOSD0,"REVR",0)) D:QAOSDATA DQ^DICQ
48 . W:QAOSDATA'>0 !?5,"*** NONE ***",!!,"Other review level choices:"
49 . Q
50 K DIC S DIC="^QA(741.2,",DIC(0)="EMNQZ"
51 S DIC("S")="I $P(^(0),""^"",2)'>3" D ^DIC K DIC G:Y'>0 ASKLEVL
52 S QAOSLEVL=+Y,QAOSLEVL(0)=Y(0,0),QAOSLVNO=$P(Y(0),"^",2)
53SEARCH ;
54 K QAOSFOND
55 S QAOSFOND="",QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSLEVL,0))
56 I QAOSLVNO=1,QAOSD1,$D(^QA(741,QAOSD0,"REVR",QAOSD1,0))#2 G EDIT
57 W:QAOSD1 !!,"Choose from:"
58 F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSLEVL,QAOSD1)) Q:QAOSD1'>0 S QAOS=$G(^QA(741,QAOSD0,"REVR",QAOSD1,0)) D:QAOS]""
59 . S QAOSFOND=QAOSFOND_QAOSD1_","
60 . S QAOSFOND(QAOSD1)=QAOSLEVL(0)_" "_$P($G(^VA(200,+$P(QAOS,"^",2),0)),"^")_" "_$P($G(^DIC(49,+$P(QAOS,"^",10),0)),"^")
61 . W !?5,QAOSD1,?15,QAOSFOND(QAOSD1)
62 . Q
63 S QAOSFOND=$E(QAOSFOND,1,$L(QAOSFOND)-1) G:QAOSFOND'>0 ASKADD
64 W !!,"Choose (",QAOSFOND,"): "
65 R QAOSD1:DTIME S:'$T QAOSD1="^" G:$E(QAOSD1)="^" ASKLEVL
66 I QAOSD1]"" D G:QA SEARCH
67 . S QA=($D(^QA(741,QAOSD0,"REVR",+QAOSD1,0))[0)
68 . S QA=((","_QAOSFOND_",")'[(","_QAOSD1_","))+QA
69 . I QA D
70 .. W:$E(QAOSD1)'="?" " ??",*7
71 .. W !!?5,"Enter one of the numbers listed below, or press RETURN"
72 .. W !?5,"to add a new ",QAOSLEVL(0)," review level. "
73 .. W "Up-arrow (^) to exit."
74 .. Q
75 . Q
76 W " ",$G(QAOSFOND(+QAOSD1))
77 G:QAOSD1 EDIT
78ASKADD ;
79 G:$O(^QA(741,QAOSD0,"REVR","B",QAOSLEVL,0))'>0 ADD
80 W *7,!!?5,"Are you adding ",QAOSLEVL(0)," as a new review level"
81 S %=2 D YN^DICN G:(%=-1)!(%=2) ASKLEVL
82 I '% D G ASKADD
83 . W !!?5,"Enter Y(es) to create a new review level."
84 . W !?5,"Enter N(o) to skip adding another review level."
85 . Q
86ADD S:$D(^QA(741,QAOSD0,"REVR",0))[0 ^(0)="^741.01IPA^^"
87 K DD,DIC,DINUM,DO S DIC="^QA(741,"_QAOSD0_",""REVR"",",DIC(0)="LM"
88 S X=QAOSLEVL,(D0,DA,DA(1))=QAOSD0
89 D FILE^DICN S QAOSD1=+Y
90EDIT ;
91 W ! D ^QAOEDT0C:QAOSLVNO=1,^QAOEDT0P:QAOSLVNO=2,^QAOEDT0M:QAOSLVNO=3
92 D AUDIT("e","CLINICAL/PEER/MANAGEMENT REVIEW") G ASKLEVL
93CHKACT ;
94 F QA=0:0 S QA=$O(^QA(741,QAOSD0,"REVR",QAOSD1,2,"B",QA)) Q:QA'>0 S QAOS=$P($G(^QA(741.7,QA,0)),"^") I QAOSFDSP("A")[("^"_QAOS_"^") S (QAOSQUIT,QAOSFDSP)=1 Q
95 Q
96RESET ;
97 W *7
98 W !!?5,"You may not change the review level, but you may delete it (@)"
99 W !?5,"if you wish. Resetting the review level to its original value."
100 W !,*7
101 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"","
102 S DR=".01////"_QAOSREVR(0),(D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1
103 D ^DIE
104 Q
105AUDIT(A,C) ; AUDIT: A = ACTION, C = COMMENT
106 N QAUDIT S QAUDIT("ACTION")=A,QAUDIT("COMMENT")=C
107 S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0
108 D ^QAQAUDIT
109 Q
Note: See TracBrowser for help on using the repository browser.