source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANFULL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1QANFULL ;HISC/GJC-Auto E-Mail for locally closed cases. ;8/6/93 10:04
2 ;;2.0;Incident Reporting;**1,13,18,20**;08/07/1992
3 ;
4 ;DON'T FORGET QAQDATE FOR AD HOC REPORTS!
5 S QANZERO=$S($D(^QA(740,1,0))#2:^(0),1:0) I +QANZERO'>0 S QANERROR=1 D ERROR G EXIT
6 S QANSITE=$S($D(^DIC(4,+QANZERO,0))#2:$P(^(0),"^"),1:"") I QANSITE="" S QANERROR=2 D ERROR G EXIT
7 S QANSTNO=$S($D(^DIC(4,+QANZERO,99))#2:$P(^(99),"^"),1:"") I QANSTNO="" S QANERROR=3 D ERROR G EXIT
8 S QANSERV=$P(QANZERO,"^",4) I QANSERV="" S QANERROR=4 D ERROR G EXIT
9 S QANDOM=$P(QANZERO,"^",5) I QANDOM="" S QANERROR=5 D ERROR G EXIT
10 S QA=+$O(^DIC(4.2,"B",QANDOM,0)) I $S('$D(^DIC(4.2,QA,0))#2:1,$P(^(0),"^")'=QANDOM:1,1:0) S QANERROR=6 D ERROR G EXIT
11 S QANQAN=$S($D(^QA(740,1,"QAN")):^("QAN"),1:"") I +QANQAN'>0 S QANERROR=7 D ERROR G EXIT
12 S QANMLGP=+$P(QANQAN,U),QANMLGP(0)=$S($D(^XMB(3.8,QANMLGP,0))#2:$P(^(0),U),1:"") I QANMLGP(0)']"" S QANERROR=7 D ERROR G EXIT
13 D INC D:$D(^UTILITY($J,"QAN MAIL")) BULL^QANFULL0
14EXIT ;Kill and quit
15 K ^UTILITY($J),C,DA,DFN,DIE,DIWF,DIWL,DIWR,DR,ERROR,QA,QAN0,QAN1,QAN742
16 K QAN7424,QANCASE,QANDATE,QANDESC,QANDOM,QANERROR,QANINCD,QANINCR
17 K QANLOOP,QANLRCP,QANLRIN,QANLVL,QANMLGP,QANNCDNT,QANOK,QANPAT
18 K QANPROV,QANQAN,QANQUIT,QANRSRV,QANSERV,QANSITE,QANSLEV,QANSRVCE
19 K QANSTNO,QANADMIT,QANDOB,QANINLOC,QANTYDTH,QANY,QANZERO,VA1026,VAIN
20 K VAINDT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
21 Q
22DESC ;Description
23 S DIWF="",DIWL=20,DIWR=60,QANDESC=1 K ^UTILITY($J,"W")
24 F QANLOOP=0:0 S QANLOOP=$O(^QA(742.4,QAN0,1,QANLOOP)) Q:QANLOOP'>0 S X=$P(^QA(742.4,QAN0,1,QANLOOP,0),U) D ^DIWP
25 Q
26ERROR ;Errors
27 W *7,!!,"*** ",$P($T(ERR+QANERROR),";;",2)," ***",!!,*7
28 Q
29INC ;Incident data, for closed incidents.
30 S QANINCR=0
31 F QAN0=0:0 S QAN0=$O(^QA(742.4,"ACS",0,QAN0)) Q:QAN0'>0 S (QANDESC,QANQUIT)=0 D INC1
32 Q
33INC1 ;Incident data
34 S QAN7424=$G(^QA(742.4,QAN0,0)) Q:QAN7424']""
35 Q:+$P(QAN7424,U,18)'=0 ;has been xmitted
36 K ^UTILITY($J,"W") ;Clean up for description
37 S QANDATE=$P(QAN7424,U,3),QANCASE=$P(QAN7424,U)
38 S QANNCDNT=$P(QAN7424,U,2),QANINLOC=$P(QAN7424,U,4)
39 S:QANINLOC]"" QANINLOC=$P($G(^QA(742.5,QANINLOC,0)),U)
40 S QANINCD=$S($D(^QA(742.1,QANNCDNT,0)):$P(^(0),U),1:"") Q:QANINCD']""
41 S QANINCD=$TR(QANINCD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
42 S QANTYDTH=$S(QANINCD="DEATH":$P(QAN7424,U,14),1:""),QANPROV=$P(QAN7424,U,16)
43 S VA1026=$P(QAN7424,U,9),QANLVL=$P(QAN7424,U,11),QANLRIN=$P(QAN7424,U,12)
44 S QANLRCP=$P(QAN7424,U,13)
45 D:$D(^QA(742.4,QAN0,1,0)) DESC
46 D EN1^QANFULL0 ;Grab patient data, build mail message
47 I QANQUIT K DA,DIE,DR S DIE="^QA(742.4,",DA=QAN0,DR=".17///^S X=4" D ^DIE K DA,DIE,DR
48 I QANQUIT K DA,DIE,DR S DIE="^QA(742.4,",DA=QAN0,DR=".21///^S X=1" D ^DIE K DA,DIE,DR
49 Q
50ERR ;;ERROR MESSAGES: REASONS EWS BULLETIN COULD NOT BE SENT
51 ;;SITE NOT FOUND IN QA SITE PARAMETERS FILE
52 ;;SITE NOT FOUND IN INSTITUTION FILE
53 ;;SITE NUMBER NOT FOUND IN INSTITUTION FILE
54 ;;NQADB MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
55 ;;NQADB DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
56 ;;NQADB DOMAIN NOT FOUND IN DOMAIN FILE
57 ;;QA INCIDENT MAILGROUP NOT FOUND IN QA SITE PARAMETERS FILE
Note: See TracBrowser for help on using the repository browser.