40 lines
1.9 KiB
Mathematica
40 lines
1.9 KiB
Mathematica
QANMAL0 ;HISC/GJC-Manually xmit data to the region (part 2) ;8/23/93 11:05
|
|
;;2.0;Incident Reporting;**1,18,20**;08/07/1992
|
|
;
|
|
EN1 ;Patient data
|
|
F QAN1=0:0 S QAN1=$O(^QA(742,"BCS",QANIEN,QAN1)) Q:QAN1'>0 D
|
|
. S QAN742=$G(^QA(742,QAN1,0))
|
|
. I QAN742]"" S QANRSRV=0 D PAT
|
|
Q
|
|
BULL ;Mail message
|
|
D KILL^XM
|
|
;S QANSERV="CEBELINSKI,G",QANDOM="SUP.QUA.ISC-CHICAGO.VA.GOV"
|
|
S XMY(QANSERV_"@"_QANDOM)="",XMDUZ=.5
|
|
S XMSUB="QAN Incident Event (Manual): "_^DD("SITE")_" ("_^DD("SITE",1)_")"
|
|
S XMTEXT="^UTILITY($J,""QAN MAIL""," D ^XMD,KILL^XM
|
|
Q
|
|
PAT ;Patient data
|
|
S QANSLEV=+$P(QAN742,U,10)
|
|
S (QANSRVCE,Y)=$P(QAN742,U,8),C=$P(^DD(742,.08,0),U,2) D:Y]"" Y^DIQ S QANSRVCE=$E(Y,1,35)
|
|
S QANINCR=QANINCR+1,QANQUIT=1
|
|
S (DFN,QANPAT)=$P(QAN742,U),QANDOB=$P(^DPT(DFN,0),U,3)
|
|
S ^UTILITY($J,"QAN PAT",QAN1)=$P(^DPT(QANPAT,0),U)
|
|
S:$D(^QA(742,QAN1,1,0)) QANRSRV=1
|
|
I +$P(QAN742,U,5) D
|
|
. S VAINDT=$G(QANDATE) D:VAINDT]"" INP^VADPT
|
|
. S QANADMIT=$P($G(VAIN(7)),U)
|
|
S ^UTILITY($J,"QAN SSN",QAN1)=$P(^DPT(QANPAT,0),U,9)
|
|
S ^UTILITY($J,"QAN MAIL",QANINCR)=QABANNER_"^"_$G(QANCASE)_"^INCD^"_$G(QANINCD)_"^"_$G(QANDATE)_"^"_$G(QANLVL)_"^"_$G(QANLRIN)_"^"_$G(QANLRCP)_"^"_$G(QANMLGP(0))_"^"_$G(VA1026)_"^"_$G(QANINLOC)_"^"_$G(QANPROV)_"^"
|
|
I QANDESC,$D(^UTILITY($J,"W",DIWL)) F QANY=0:0 S QANY=$O(^UTILITY($J,"W",DIWL,QANY)) Q:QANY'>0 S QANINCR=QANINCR+1,^UTILITY($J,"QAN MAIL",QANINCR)=QABANNER_"^"_QANCASE_"^DESC^"_^UTILITY($J,"W",DIWL,QANY,0)_"^"
|
|
I QANRSRV D
|
|
. S QAN=0
|
|
. F S QAN=$O(^QA(742,QAN1,1,QAN)) Q:QAN'>0 D
|
|
.. S QANRSRV("I")=$P($G(^QA(742,QAN1,1,QAN,0)),U)
|
|
.. Q:QANRSRV("I")']""
|
|
.. S QANRSRV("X")=$P($G(^ECC(730,QANRSRV("I"),0)),U)
|
|
.. S QANINCR=QANINCR+1
|
|
.. S ^UTILITY($J,"QAN MAIL",QANINCR)=QABANNER_"^"_$G(QANCASE)_"^RSRV^"_QANRSRV("X")_"^"
|
|
S QANINCR=QANINCR+1
|
|
S ^UTILITY($J,"QAN MAIL",QANINCR)=QABANNER_"^"_$G(QANCASE)_"^PAT^"_$G(^UTILITY($J,"QAN PAT",QAN1))_"^"_$G(^UTILITY($J,"QAN SSN",QAN1))_"^"_$G(QANSLEV)_"^"_$G(QANTYDTH)_"^"_$G(QANSRVCE)_"^"_$G(QANADMIT)_"^"_$G(QANDOB)_"^"
|
|
Q
|