| [613] | 1 | QANMAIL ;HISC/GJC-Manually xmit data to the region (part 1) ;8/23/93 13:39
|
|---|
| 2 | ;;2.0;Incident Reporting;**1,18,20**;08/07/1992
|
|---|
| 3 | EN1 ;Manually xmit data
|
|---|
| 4 | S (QANQUIT,QANXIT)=0 K ^UTILITY($J,"QAN MAIL")
|
|---|
| 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 INCD ;Set incident data
|
|---|
| 14 | I QANXIT D EXIT Q
|
|---|
| 15 | D:$D(^UTILITY($J,"QAN MAIL")) BULL^QANMAL0
|
|---|
| 16 | W !!?5,$S($D(^UTILITY($J,"QAN MAIL")):"Data transmitted to the region.",1:"No data found!")
|
|---|
| 17 | EXIT ;Kill and quit
|
|---|
| 18 | D KILL^XUSCLEAN K ^UTILITY($J,"QAN MAIL")
|
|---|
| 19 | Q
|
|---|
| 20 | ERROR ;Find error type
|
|---|
| 21 | W *7,!!,"*** ",$P($T(ERR+QANERROR),";;",2)," ***",!!,*7
|
|---|
| 22 | Q
|
|---|
| 23 | INCD ;
|
|---|
| 24 | ;Choose the incident, put into report option
|
|---|
| 25 | ;*** QANIEN IS FILE 742.4'S IEN ***
|
|---|
| 26 | K DD,DLAYGO,DO,DINUM,D,DIC S QANTYPE=1,DIC="^QA(742.4,",DIC(0)="QEANZ",DIC("A")="Select Incident Case Number: ",DIC("W")="D EN1^QANUTL"
|
|---|
| 27 | S DIC("S")="I +$P(^(0),U,18)=0"
|
|---|
| 28 | D ^DIC K DD,DLAYGO,DINUM,DO,D,DIC
|
|---|
| 29 | I +Y=-1 W !!,*7,"Incident not selected, exiting!!" Q
|
|---|
| 30 | E S QANIEN=+Y
|
|---|
| 31 | S QAN7424=$G(^QA(742.4,QANIEN,0)) S:QAN7424']"" QANXIT=1
|
|---|
| 32 | Q:QANXIT S (QANDESC,QANINCR)=0
|
|---|
| 33 | S QANDATE=$P(QAN7424,U,3),QANCASE=$P(QAN7424,U)
|
|---|
| 34 | S QANNCDNT=$P(QAN7424,U,2),QANINLOC=$P(QAN7424,U,4)
|
|---|
| 35 | S:QANINLOC]"" QANINLOC=$P($G(^QA(742.5,QANINLOC,0)),U)
|
|---|
| 36 | S QANINCD=$P($G(^QA(742.1,QANNCDNT,0)),U)
|
|---|
| 37 | S:QANINCD']"" QANXIT=1 Q:QANXIT
|
|---|
| 38 | S QANINCD=$TR(QANINCD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 39 | S QANTYDTH=$S(QANINCD="DEATH":$P(QAN7424,U,14),1:"")
|
|---|
| 40 | S QANLCST=$P(QAN7424,U,8)
|
|---|
| 41 | S QABANNER=$S(QANLCST=0:"CMAN",QANLCST=2:"DMAN",1:"OMAN")
|
|---|
| 42 | S VA1026=+$P(QAN7424,U,9),QANLVL=$P(QAN7424,U,11)
|
|---|
| 43 | S QANLRIN=$P(QAN7424,U,12),QANLRCP=$P(QAN7424,U,13)
|
|---|
| 44 | I $D(^QA(742.4,QANIEN,1,0)) D DESC
|
|---|
| 45 | D EN1^QANMAL0 ;Grab all associated patient data
|
|---|
| 46 | I QANQUIT D
|
|---|
| 47 | . K DA,DIE,DR S DA=QANIEN,DIE="^QA(742.4,"
|
|---|
| 48 | . S DR=".17////"_QANLCST_";.21////1" D ^DIE
|
|---|
| 49 | . K DIE,DA,DR
|
|---|
| 50 | Q
|
|---|
| 51 | DESC ;Grab description data
|
|---|
| 52 | S DIWF="",DIWL=20,DIWR=60,QANDESC=1 K ^UTILITY($J,"W")
|
|---|
| 53 | F QANLOOP=0:0 S QANLOOP=$O(^QA(742.4,QANIEN,1,QANLOOP)) Q:QANLOOP'>0 S X=$P(^QA(742.4,QANIEN,1,QANLOOP,0),U) D ^DIWP
|
|---|
| 54 | Q
|
|---|
| 55 | ERR ;;ERROR MESSAGES: REASONS EWS BULLETIN COULD NOT BE SENT
|
|---|
| 56 | ;;SITE NOT FOUND IN QA SITE PARAMETERS FILE
|
|---|
| 57 | ;;SITE NOT FOUND IN INSTITUTION FILE
|
|---|
| 58 | ;;SITE NUMBER NOT FOUND IN INSTITUTION FILE
|
|---|
| 59 | ;;NQADB MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
|
|---|
| 60 | ;;NQADB DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
|
|---|
| 61 | ;;NQADB DOMAIN NOT FOUND IN DOMAIN FILE
|
|---|
| 62 | ;;QA INCIDENT MAILGROUP NOT FOUND IN QA SITE PARAMETERS FILE
|
|---|
