QANBENE0 ;HISC/GJC-SPECIAL INCIDENTS INVOL. A BENEFICIARY ;4/13/93 08:24
;;2.0;Incident Reporting;**18,26,28,29**;08/07/1992
;
EN1 ;/*** Catagorize incidents ***/
K DIR S DIR(0)="FAO^1:1^K:""ACDINO""'[X X",DIR("A")="Select Ward type (A/C/D/I/N/O): "
S DIR("?",1)="Enter ""A"" to generate separate reports for Domiciliaries, NHCU'S, "
S DIR("?",2)="Inpatients and Outpatients."
S DIR("?",3)="Enter ""C"" to generate a report of combined data for Domiciliaries, NHCU'S, "
S DIR("?",4)="Inpatients and Outpatients."
S DIR("?",5)="Enter ""D"" for Domiciliary, ""I"" for Inpatients other than Domiciliary or "
S DIR("?")="NHCU, ""N"" for NHCU units, or ""O"" for Outpatients."
D ^DIR K DIR
I $D(DIRUT) D KILL Q
S QANFLG("WARD")=Y
TASK ;Call to %ZTLOAD
S Y=DT X ^DD("DD") S TODAY=Y
K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="MQ" W ! D ^%ZIS W !!
G:POP KILL
I $D(IO("Q")) S ZTRTN="START^QANBENE0",ZTDESC="Generate Special Incident Reports For A Beneficiary." D QLOOP,^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!"),! G EXIT
START ;IO requests
U IO
I QANFLG("WARD")="A" S QANFLG("WARD A")="D^I^N^O"
I $D(QANFLG("WARD A")),(QANFLG("WARD A")="D^I^N^O") F QAN=1:1:$L(QANFLG("WARD A"),"^") Q:QANQUIT S QANFLG("WARD")=$P(QANFLG("WARD A"),"^",QAN) Q:QANFLG("WARD")']"" D
. W @IOF
. S PAGE=0
. K ^TMP("QANBEN",$J),QANCOUNT
. D GO D:'QANQUIT HDH^QANBENE3 Q:QANQUIT
G:QANQUIT EXIT
I '$D(QANFLG("WARD A")) D GO
I $D(^TMP("QANBEN",$J,"NOBEN")) D PRNOBEN
EXIT ;
W ! D ^%ZISC,HOME^%ZIS
KILL ;Kill and quit.
K %ZIS,D,DIC,DIRUT,I,PAGE,POP
K QAN,QAN742,QAN7424,QANAA,QANAB,QANBB,QANBENE,QANCC,QANCONT
K QANCOUNT,QANDATE,QAN1DIV,QANDIV,QANDTH,QANDV,QANDVFLG
K QANFLG,QANHEAD,QANHLOC,QANINPT,QANLBL,QANLP,QANLWLT
K QANPTTY,QANQUIT,QANSLEV,QANSTAT,QANTAB,QANUPLT,QANWARD
K QANINVST,QANSITE,QANSWCH,QANWHICH
K QAQNBEG,QAQNEND
K TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
D K^QAQDATE
K ^TMP("QANBEN",$J)
Q
GO ;Set up variables.
S QANOWARD=0
S QANLP=QANLWLT
F S QANLP=$O(^QA(742.4,"BDT",QANLP)) Q:QANLP'>0!(QANLP>QANUPLT) D
. S QANLP(1)=0
. F S QANLP(1)=$O(^QA(742.4,"BDT",QANLP,QANLP(1))) Q:QANLP(1)'>0 D
. . I $G(^QA(742.4,QANLP(1),0))]"" D LGIC I QANQUIT S QANQUIT=0 Q
. . S QANLP(2)=0
. . F S QANLP(2)=$O(^QA(742,"BCS",QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
. . . I $G(^QA(742,QANLP(2),0)) D LGIC1
. . . I QANQUIT S QANQUIT=0 Q
. . . S ^TMP("QANBEN",$J,"BEN",QANDIV,QANWARD,QANLP(1),QANLP(2))=""
S QANHEAD(3)=$S(QANFLG("WARD")="I":"INPATIENTS",QANFLG("WARD")="D":"DOMICILIARY",QANFLG("WARD")="N":"NHCU",QANFLG("WARD")="O":"OUTPATIENTS",1:"ALL INCIDENTS REGARDLESS OF LOCATION")
I $G(QANDVFLG)'=1 D HDR
D EN1^QANBENE1
Q
LGIC ;Set up valid incidents
S QAN7424=^QA(742.4,QANLP(1),0),QAN("INC")=$P(QAN7424,U,2)
I QAN("INC")'<200 S QANQUIT=1 Q ;Quit if NOT a National incident.
D VALID^QANBENE I 'QANSWCH S QANQUIT=1 Q ;Quit if NOT a valid incident
S QANSTAT=+$P(QAN7424,U,8),QANBENE=+$P(QAN7424,U,17)
I 'QANBENE!(QANFLG("IR STAT")'[QANSTAT) S QANQUIT=1 Q
S QANDIV=$P(QAN7424,U,22)
I $G(QANDIV)']"" S QANDIV=0
I $G(QAN1DIV)]"" I QAN1DIV'=QANDIV S QANQUIT=1 Q
I '$D(^QA(740,1,"QAN2","B",QANDIV)) S QANDIV=0
I $G(QANDVFLG)'=1 S QANDIV=0
Q
HDR ;Header generator.
S PAGE=PAGE+1 W @IOF,!?69,TODAY,!?69,"Page: ",PAGE,!!
W ?(IOM-$L(QANHEAD(0))\2),QANHEAD(0),!,?(IOM-$L(QANHEAD(1))\2),QANHEAD(1),!
W !?(IOM-$L(QANHEAD(2))\2),QANHEAD(2),!
W !?(IOM-$L(QANHEAD(3))\2),QANHEAD(3)
I $G(QANDVFLG)=1,($G(QANHEAD(4))]"") W !?(IOM-$L(QANHEAD(4))\2),QANHEAD(4)
W !!?QANTAB(5),"Total",?QANTAB(6),"Resulted in"
W !?QANTAB(2),"Incident",?QANTAB(4),"Severity",?QANTAB(5),"Number",?QANTAB(6),"Investigation",!?QANTAB(2),"--------",?QANTAB(4),"--------",?QANTAB(5),"------",?QANTAB(6),"-------------"
I QANCONT,$D(QANLBL) W !!?QANTAB(2),QANLBL_" (cont)"
Q
LGIC1 ;Sorting wards into categories.
Q:$D(^QA(742,"BPRS",-1,QANLP(2))) ;Quit if a deleted patient
S QAN742=^QA(742,QANLP(2),0)
S QANPTTY=+$P(QAN742,U,5),QANWARD=+$P(QAN742,U,6),QANSLEV=+$P(QAN742,U,10)
I $G(QANWARD)'>0 D
. S QANINUM=$P(QAN7424,U) ;Incident number
. S QANWHY="No ward entered for Incident." ;why excluded from report
. D NOBEN
. S QANQUIT=1 Q
I '$D(^SC(QANWARD)) D
. S QANINUM=$P(QAN7424,U) ;Incident number
. S QANWHY="Ward has no valid Hospital Location." ;why excluded
. D NOBEN
. S QANQUIT=1 Q
D WARD
Q
QLOOP ;Save variables for %ZTLOAD.
F I="^TMP(""QANBEN"",$J,","PAGE","TODAY","QAN*","QAQ*" S ZTSAVE(I)=""
Q
WARD ;determine if record should be included in report
S QANWARD=$G(^SC(QANWARD,42)) D
. I $G(QANWARD)']"" S QANWARD="O" Q
. I $G(QANWARD) S QANWARD=$P(^DIC(42,QANWARD,0),U,3)
. I $G(QANWARD)]"" S QANWARD=$S($G(QANWARD)="D":"D",$G(QANWARD)="NH":"N",1:"I") Q
. I $G(QANWARD)']"" S QANWARD="O"
S QANXXX=$S(QANFLG("WARD")="C":1,QANFLG("WARD")="A":1,QANFLG("WARD")=QANWARD:1,$G(QANFLG("WARD A")):1,1:0)
I QANXXX<1 S QANQUIT=1 Q
Q
TALLY ;create and increment globals for report
S QANCOUNT("SLEV",QANAA,QANLBL,QANSLEV)=$G(QANCOUNT("SLEV",QANAA,QANLBL,QANSLEV))+1
I $G(QANINVST)>1 S QANCOUNT("INV",QANAA,QANLBL,QANSLEV)=$G(QANCOUNT("INV",QANAA,QANLBL,QANSLEV))+1
Q
NOBEN ;process those records without valid ward information for exception
;report
S QANOWARD=QANOWARD+1
S ^TMP("QANBEN",$J,"NOBEN",QANOWARD)=QANINUM_"^"_QANWHY
Q
PRNOBEN ;print list of records excluded from report
I '$D(^TMP("QANBEN",$J,"NOBEN")) Q
D HDH2
W !!!?25,"EXCEPTION REPORT"
W !?10,"The following records were excluded from this report."
W !?10,"_____________________________________________________"
W !!?5,"Incident Number",?35,"Reason for Exclusion"
W !?5,"---------------",?35,"--------------------"
S QANE=0
F S QANE=$O(^TMP("QANBEN",$J,"NOBEN",QANE)) Q:QANE'>0 D
. S QANLINE=^TMP("QANBEN",$J,"NOBEN",QANE)
. D:$Y>(IOSL-4) HDH^QANBENE2 Q:QANQUIT
. W !?6,$P(QANLINE,U),?32,$P(QANLINE,U,2)
W !!!?25,"End of Report."
Q
HDH2 ;header for exception report
W @IOF
W !?(IOM-$L(QANHEAD(0))\2),QANHEAD(0)
W !?(IOM-$L(QANHEAD(1))\2),QANHEAD(1)
W !!?(IOM-$L(QANHEAD(2))\2),QANHEAD(2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANBENE0 6171 printed Oct 16, 2024@18:00:17 Page 2
QANBENE0 ;HISC/GJC-SPECIAL INCIDENTS INVOL. A BENEFICIARY ;4/13/93 08:24
+1 ;;2.0;Incident Reporting;**18,26,28,29**;08/07/1992
+2 ;
EN1 ;/*** Catagorize incidents ***/
+1 KILL DIR
SET DIR(0)="FAO^1:1^K:""ACDINO""'[X X"
SET DIR("A")="Select Ward type (A/C/D/I/N/O): "
+2 SET DIR("?",1)="Enter ""A"" to generate separate reports for Domiciliaries, NHCU'S, "
+3 SET DIR("?",2)="Inpatients and Outpatients."
+4 SET DIR("?",3)="Enter ""C"" to generate a report of combined data for Domiciliaries, NHCU'S, "
+5 SET DIR("?",4)="Inpatients and Outpatients."
+6 SET DIR("?",5)="Enter ""D"" for Domiciliary, ""I"" for Inpatients other than Domiciliary or "
+7 SET DIR("?")="NHCU, ""N"" for NHCU units, or ""O"" for Outpatients."
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
DO KILL
QUIT
+10 SET QANFLG("WARD")=Y
TASK ;Call to %ZTLOAD
+1 SET Y=DT
XECUTE ^DD("DD")
SET TODAY=Y
+2 KILL IOP,%ZIS
SET %ZIS("A")="Print on device: "
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
WRITE !!
+3 if POP
GOTO KILL
+4 IF $DATA(IO("Q"))
SET ZTRTN="START^QANBENE0"
SET ZTDESC="Generate Special Incident Reports For A Beneficiary."
DO QLOOP
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!"),!
GOTO EXIT
START ;IO requests
+1 USE IO
+2 IF QANFLG("WARD")="A"
SET QANFLG("WARD A")="D^I^N^O"
+3 IF $DATA(QANFLG("WARD A"))
IF (QANFLG("WARD A")="D^I^N^O")
FOR QAN=1:1:$LENGTH(QANFLG("WARD A"),"^")
if QANQUIT
QUIT
SET QANFLG("WARD")=$PIECE(QANFLG("WARD A"),"^",QAN)
if QANFLG("WARD")']""
QUIT
Begin DoDot:1
+4 WRITE @IOF
+5 SET PAGE=0
+6 KILL ^TMP("QANBEN",$JOB),QANCOUNT
+7 DO GO
if 'QANQUIT
DO HDH^QANBENE3
if QANQUIT
QUIT
End DoDot:1
+8 if QANQUIT
GOTO EXIT
+9 IF '$DATA(QANFLG("WARD A"))
DO GO
+10 IF $DATA(^TMP("QANBEN",$JOB,"NOBEN"))
DO PRNOBEN
EXIT ;
+1 WRITE !
DO ^%ZISC
DO HOME^%ZIS
KILL ;Kill and quit.
+1 KILL %ZIS,D,DIC,DIRUT,I,PAGE,POP
+2 KILL QAN,QAN742,QAN7424,QANAA,QANAB,QANBB,QANBENE,QANCC,QANCONT
+3 KILL QANCOUNT,QANDATE,QAN1DIV,QANDIV,QANDTH,QANDV,QANDVFLG
+4 KILL QANFLG,QANHEAD,QANHLOC,QANINPT,QANLBL,QANLP,QANLWLT
+5 KILL QANPTTY,QANQUIT,QANSLEV,QANSTAT,QANTAB,QANUPLT,QANWARD
+6 KILL QANINVST,QANSITE,QANSWCH,QANWHICH
+7 KILL QAQNBEG,QAQNEND
+8 KILL TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+9 DO K^QAQDATE
+10 KILL ^TMP("QANBEN",$JOB)
+11 QUIT
GO ;Set up variables.
+1 SET QANOWARD=0
+2 SET QANLP=QANLWLT
+3 FOR
SET QANLP=$ORDER(^QA(742.4,"BDT",QANLP))
if QANLP'>0!(QANLP>QANUPLT)
QUIT
Begin DoDot:1
+4 SET QANLP(1)=0
+5 FOR
SET QANLP(1)=$ORDER(^QA(742.4,"BDT",QANLP,QANLP(1)))
if QANLP(1)'>0
QUIT
Begin DoDot:2
+6 IF $GET(^QA(742.4,QANLP(1),0))]""
DO LGIC
IF QANQUIT
SET QANQUIT=0
QUIT
+7 SET QANLP(2)=0
+8 FOR
SET QANLP(2)=$ORDER(^QA(742,"BCS",QANLP(1),QANLP(2)))
if QANLP(2)'>0
QUIT
Begin DoDot:3
+9 IF $GET(^QA(742,QANLP(2),0))
DO LGIC1
+10 IF QANQUIT
SET QANQUIT=0
QUIT
+11 SET ^TMP("QANBEN",$JOB,"BEN",QANDIV,QANWARD,QANLP(1),QANLP(2))=""
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET QANHEAD(3)=$SELECT(QANFLG("WARD")="I":"INPATIENTS",QANFLG("WARD")="D":"DOMICILIARY",QANFLG("WARD")="N":"NHCU",QANFLG("WARD")="O":"OUTPATIENTS",1:"ALL INCIDENTS REGARDLESS OF LOCATION")
+13 IF $GET(QANDVFLG)'=1
DO HDR
+14 DO EN1^QANBENE1
+15 QUIT
LGIC ;Set up valid incidents
+1 SET QAN7424=^QA(742.4,QANLP(1),0)
SET QAN("INC")=$PIECE(QAN7424,U,2)
+2 ;Quit if NOT a National incident.
IF QAN("INC")'<200
SET QANQUIT=1
QUIT
+3 ;Quit if NOT a valid incident
DO VALID^QANBENE
IF 'QANSWCH
SET QANQUIT=1
QUIT
+4 SET QANSTAT=+$PIECE(QAN7424,U,8)
SET QANBENE=+$PIECE(QAN7424,U,17)
+5 IF 'QANBENE!(QANFLG("IR STAT")'[QANSTAT)
SET QANQUIT=1
QUIT
+6 SET QANDIV=$PIECE(QAN7424,U,22)
+7 IF $GET(QANDIV)']""
SET QANDIV=0
+8 IF $GET(QAN1DIV)]""
IF QAN1DIV'=QANDIV
SET QANQUIT=1
QUIT
+9 IF '$DATA(^QA(740,1,"QAN2","B",QANDIV))
SET QANDIV=0
+10 IF $GET(QANDVFLG)'=1
SET QANDIV=0
+11 QUIT
HDR ;Header generator.
+1 SET PAGE=PAGE+1
WRITE @IOF,!?69,TODAY,!?69,"Page: ",PAGE,!!
+2 WRITE ?(IOM-$LENGTH(QANHEAD(0))\2),QANHEAD(0),!,?(IOM-$LENGTH(QANHEAD(1))\2),QANHEAD(1),!
+3 WRITE !?(IOM-$LENGTH(QANHEAD(2))\2),QANHEAD(2),!
+4 WRITE !?(IOM-$LENGTH(QANHEAD(3))\2),QANHEAD(3)
+5 IF $GET(QANDVFLG)=1
IF ($GET(QANHEAD(4))]"")
WRITE !?(IOM-$LENGTH(QANHEAD(4))\2),QANHEAD(4)
+6 WRITE !!?QANTAB(5),"Total",?QANTAB(6),"Resulted in"
+7 WRITE !?QANTAB(2),"Incident",?QANTAB(4),"Severity",?QANTAB(5),"Number",?QANTAB(6),"Investigation",!?QANTAB(2),"--------",?QANTAB(4),"--------",?QANTAB(5),"------",?QANTAB(6),"-------------"
+8 IF QANCONT
IF $DATA(QANLBL)
WRITE !!?QANTAB(2),QANLBL_" (cont)"
+9 QUIT
LGIC1 ;Sorting wards into categories.
+1 ;Quit if a deleted patient
if $DATA(^QA(742,"BPRS",-1,QANLP(2)))
QUIT
+2 SET QAN742=^QA(742,QANLP(2),0)
+3 SET QANPTTY=+$PIECE(QAN742,U,5)
SET QANWARD=+$PIECE(QAN742,U,6)
SET QANSLEV=+$PIECE(QAN742,U,10)
+4 IF $GET(QANWARD)'>0
Begin DoDot:1
+5 ;Incident number
SET QANINUM=$PIECE(QAN7424,U)
+6 ;why excluded from report
SET QANWHY="No ward entered for Incident."
+7 DO NOBEN
+8 SET QANQUIT=1
QUIT
End DoDot:1
+9 IF '$DATA(^SC(QANWARD))
Begin DoDot:1
+10 ;Incident number
SET QANINUM=$PIECE(QAN7424,U)
+11 ;why excluded
SET QANWHY="Ward has no valid Hospital Location."
+12 DO NOBEN
+13 SET QANQUIT=1
QUIT
End DoDot:1
+14 DO WARD
+15 QUIT
QLOOP ;Save variables for %ZTLOAD.
+1 FOR I="^TMP(""QANBEN"",$J,","PAGE","TODAY","QAN*","QAQ*"
SET ZTSAVE(I)=""
+2 QUIT
WARD ;determine if record should be included in report
+1 SET QANWARD=$GET(^SC(QANWARD,42))
Begin DoDot:1
+2 IF $GET(QANWARD)']""
SET QANWARD="O"
QUIT
+3 IF $GET(QANWARD)
SET QANWARD=$PIECE(^DIC(42,QANWARD,0),U,3)
+4 IF $GET(QANWARD)]""
SET QANWARD=$SELECT($GET(QANWARD)="D":"D",$GET(QANWARD)="NH":"N",1:"I")
QUIT
+5 IF $GET(QANWARD)']""
SET QANWARD="O"
End DoDot:1
+6 SET QANXXX=$SELECT(QANFLG("WARD")="C":1,QANFLG("WARD")="A":1,QANFLG("WARD")=QANWARD:1,$GET(QANFLG("WARD A")):1,1:0)
+7 IF QANXXX<1
SET QANQUIT=1
QUIT
+8 QUIT
TALLY ;create and increment globals for report
+1 SET QANCOUNT("SLEV",QANAA,QANLBL,QANSLEV)=$GET(QANCOUNT("SLEV",QANAA,QANLBL,QANSLEV))+1
+2 IF $GET(QANINVST)>1
SET QANCOUNT("INV",QANAA,QANLBL,QANSLEV)=$GET(QANCOUNT("INV",QANAA,QANLBL,QANSLEV))+1
+3 QUIT
NOBEN ;process those records without valid ward information for exception
+1 ;report
+2 SET QANOWARD=QANOWARD+1
+3 SET ^TMP("QANBEN",$JOB,"NOBEN",QANOWARD)=QANINUM_"^"_QANWHY
+4 QUIT
PRNOBEN ;print list of records excluded from report
+1 IF '$DATA(^TMP("QANBEN",$JOB,"NOBEN"))
QUIT
+2 DO HDH2
+3 WRITE !!!?25,"EXCEPTION REPORT"
+4 WRITE !?10,"The following records were excluded from this report."
+5 WRITE !?10,"_____________________________________________________"
+6 WRITE !!?5,"Incident Number",?35,"Reason for Exclusion"
+7 WRITE !?5,"---------------",?35,"--------------------"
+8 SET QANE=0
+9 FOR
SET QANE=$ORDER(^TMP("QANBEN",$JOB,"NOBEN",QANE))
if QANE'>0
QUIT
Begin DoDot:1
+10 SET QANLINE=^TMP("QANBEN",$JOB,"NOBEN",QANE)
+11 if $Y>(IOSL-4)
DO HDH^QANBENE2
if QANQUIT
QUIT
+12 WRITE !?6,$PIECE(QANLINE,U),?32,$PIECE(QANLINE,U,2)
End DoDot:1
+13 WRITE !!!?25,"End of Report."
+14 QUIT
HDH2 ;header for exception report
+1 WRITE @IOF
+2 WRITE !?(IOM-$LENGTH(QANHEAD(0))\2),QANHEAD(0)
+3 WRITE !?(IOM-$LENGTH(QANHEAD(1))\2),QANHEAD(1)
+4 WRITE !!?(IOM-$LENGTH(QANHEAD(2))\2),QANHEAD(2)
+5 QUIT
