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.DOMAIN.EXT"
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANMAL0 2034 printed Nov 22, 2024@17:10:02 Page 2
QANMAL0 ;HISC/GJC-Manually xmit data to the region (part 2) ;8/23/93 11:05
+1 ;;2.0;Incident Reporting;**1,18,20**;08/07/1992
+2 ;
EN1 ;Patient data
+1 FOR QAN1=0:0
SET QAN1=$ORDER(^QA(742,"BCS",QANIEN,QAN1))
if QAN1'>0
QUIT
Begin DoDot:1
+2 SET QAN742=$GET(^QA(742,QAN1,0))
+3 IF QAN742]""
SET QANRSRV=0
DO PAT
End DoDot:1
+4 QUIT
BULL ;Mail message
+1 DO KILL^XM
+2 ;S QANSERV="CEBELINSKI,G",QANDOM="SUP.QUA.ISC-CHICAGO.DOMAIN.EXT"
+3 SET XMY(QANSERV_"@"_QANDOM)=""
SET XMDUZ=.5
+4 SET XMSUB="QAN Incident Event (Manual): "_^DD("SITE")_" ("_^DD("SITE",1)_")"
+5 SET XMTEXT="^UTILITY($J,""QAN MAIL"","
DO ^XMD
DO KILL^XM
+6 QUIT
PAT ;Patient data
+1 SET QANSLEV=+$PIECE(QAN742,U,10)
+2 SET (QANSRVCE,Y)=$PIECE(QAN742,U,8)
SET C=$PIECE(^DD(742,.08,0),U,2)
if Y]""
DO Y^DIQ
SET QANSRVCE=$EXTRACT(Y,1,35)
+3 SET QANINCR=QANINCR+1
SET QANQUIT=1
+4 SET (DFN,QANPAT)=$PIECE(QAN742,U)
SET QANDOB=$PIECE(^DPT(DFN,0),U,3)
+5 SET ^UTILITY($JOB,"QAN PAT",QAN1)=$PIECE(^DPT(QANPAT,0),U)
+6 if $DATA(^QA(742,QAN1,1,0))
SET QANRSRV=1
+7 IF +$PIECE(QAN742,U,5)
Begin DoDot:1
+8 SET VAINDT=$GET(QANDATE)
if VAINDT]""
DO INP^VADPT
+9 SET QANADMIT=$PIECE($GET(VAIN(7)),U)
End DoDot:1
+10 SET ^UTILITY($JOB,"QAN SSN",QAN1)=$PIECE(^DPT(QANPAT,0),U,9)
+11 SET ^UTILITY($JOB,"QAN MAIL",QANINCR)=QABANNER_"^"_$GET(QANCASE)_"^INCD^"_$GET(QANINCD)_"^"_$GET(QANDATE)_"^"_$GET(QANLVL)_"^"_$GET(QANLRIN)_"^"_$GET(QANLRCP)_"^"_$GET(QANMLGP(0))_"^"_$GET(VA1026)_"^"_$GET(QANINLOC)_"^"_$GET(QANPROV)_"^"
+12 IF QANDESC
IF $DATA(^UTILITY($JOB,"W",DIWL))
FOR QANY=0:0
SET QANY=$ORDER(^UTILITY($JOB,"W",DIWL,QANY))
if QANY'>0
QUIT
SET QANINCR=QANINCR+1
SET ^UTILITY($JOB,"QAN MAIL",QANINCR)=QABANNER_"^"_QANCASE_"^DESC^"_^UTILITY($JOB,"W",DIWL,QANY,0)_"^"
+13 IF QANRSRV
Begin DoDot:1
+14 SET QAN=0
+15 FOR
SET QAN=$ORDER(^QA(742,QAN1,1,QAN))
if QAN'>0
QUIT
Begin DoDot:2
+16 SET QANRSRV("I")=$PIECE($GET(^QA(742,QAN1,1,QAN,0)),U)
+17 if QANRSRV("I")']""
QUIT
+18 SET QANRSRV("X")=$PIECE($GET(^ECC(730,QANRSRV("I"),0)),U)
+19 SET QANINCR=QANINCR+1
+20 SET ^UTILITY($JOB,"QAN MAIL",QANINCR)=QABANNER_"^"_$GET(QANCASE)_"^RSRV^"_QANRSRV("X")_"^"
End DoDot:2
End DoDot:1
+21 SET QANINCR=QANINCR+1
+22 SET ^UTILITY($JOB,"QAN MAIL",QANINCR)=QABANNER_"^"_$GET(QANCASE)_"^PAT^"_$GET(^UTILITY($JOB,"QAN PAT",QAN1))_"^"_$GET(^UTILITY($JOB,"QAN SSN",QAN1))_"^"_$GET(QANSLEV)_"^"_$GET(QANTYDTH)_"^"_$GET(QANSRVCE)_"^"_$GET(QANADMIT)_"^"_$GET(QANDOB)_"^"
+23 QUIT
