QANDBXX ;GJC/HISC-Database Checker ;4/1/92
;;2.0;Incident Reporting;;08/07/1992
;
S (QANFLG,QANPG,QANXIT)=0
S QANHD1="Quality Assurance Database Integrity Checker"
S QANHD2="Incident Reporting Version 2.0"
S QANHD3="No evidence of database corruption found."
S $P(QANLINE,"*",81)=""
DEV ;Select Device
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^QANDBXX",ZTDESC="IR database report",ZTSAVE("QAN*")="" D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued.",1:"Request Cancelled."),! G EXIT
START U IO D HDR
F QA=0:0 S QA=$O(^QA(742,"BCS",QA)) Q:QA'>0 D CASE Q:QANXIT
W !?(IOM-$L(QANHD3)\2),$S('QANFLG:QANHD3,1:"")
EXIT ;Exit
W ! D ^%ZISC,HOME^%ZIS
KILL ;Kill and quit
K %H,%ZIS,IZ,POP,QANFLG,QANHD1,QANHD2,QANHD3,QANLINE,QANPG,QANXIT,ZTSK
K D,QA,QAN742,QAN7424,QANCS,QB,TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE
Q
CASE ;Case Number information
S QAN7424=$G(^QA(742.4,QA,0))
S QANCS(1)=$P(QAN7424,U),QANCS(2)=$P(QAN7424,U,2),QANCS(3)=$P(QAN7424,U,3)
I QAN7424']"" W !,"Incident Record Number: ",QA," does NOT have data associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
I QANCS(1)']"" W !,"Incident Record Number: ",QA," does NOT have a Case Number associated with the",!,"record!" D:$Y>(IOSL-4) HDH Q:QANXIT
I QANCS(2)']"" W !,"Incident Record Number: ",QA," does NOT have a Incident associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
I QANCS(3)']"" W !,"Incident Record Number: ",QA," does NOT have a Incident Date associated with the",!,"record!" D:$Y>(IOSL-4) HDH Q:QANXIT
F QB=0:0 S QB=$O(^QA(742,"BCS",QA,QB)) Q:QB'>0 D PAT Q:QANXIT
Q
PAT ;Patient Information
S QAN742=$G(^QA(742,QB,0))
I QAN742']"" W !,"Patient Record Number: ",QB," does NOT have data associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
I '$D(^QA(742.4,"ACN",QB,QA)) S QANFLG=1 W !,"'ACN' x-ref missing for Patient Record: ",QB," Incident Record: ",QA D:$Y>(IOSL-4) HDH Q:QANXIT
S QANCS(4)=$P(QAN742,U),QANCS(5)=$P(QAN742,U,2),QANCS(6)=$P(QAN742,U,3)
I QANCS(4)']"" S QANFLG=1 W !,"Patient Record Number: ",QA," does NOT have a Patient associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
I QANCS(5)']"" S QANFLG=1 W !,"Patient Record Number: ",QA," does NOT have a Patient ID associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
I QANCS(6)']"" S QANFLG=1 W !,"Patient Record Number: ",QA," does NOT have a Incident associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
Q
HDH ;Header Prompt
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANXIT=1 Q:QANXIT
HDR ;Header
W @IOF
S QANPG=QANPG+1,%H=$H D YX^%DTC S TODAY=Y
W ?69,"Page: ",QANPG,!?58,TODAY,!!
W ?(IOM-$L(QANHD1)\2),QANHD1,!?(IOM-$L(QANHD2)\2),QANHD2,!!
F IZ=1:1:2 W QANLINE,!
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANDBXX 2778 printed Apr 09, 2024@21:01:30 Page 2
QANDBXX ;GJC/HISC-Database Checker ;4/1/92
+1 ;;2.0;Incident Reporting;;08/07/1992
+2 ;
+3 SET (QANFLG,QANPG,QANXIT)=0
+4 SET QANHD1="Quality Assurance Database Integrity Checker"
+5 SET QANHD2="Incident Reporting Version 2.0"
+6 SET QANHD3="No evidence of database corruption found."
+7 SET $PIECE(QANLINE,"*",81)=""
DEV ;Select Device
+1 KILL IOP,%ZIS
SET %ZIS("A")="Print on Device: "
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
WRITE !!
+2 if POP
GOTO KILL
+3 IF $DATA(IO("Q"))
SET ZTRTN="START^QANDBXX"
SET ZTDESC="IR database report"
SET ZTSAVE("QAN*")=""
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued.",1:"Request Cancelled."),!
GOTO EXIT
START USE IO
DO HDR
+1 FOR QA=0:0
SET QA=$ORDER(^QA(742,"BCS",QA))
if QA'>0
QUIT
DO CASE
if QANXIT
QUIT
+2 WRITE !?(IOM-$LENGTH(QANHD3)\2),$SELECT('QANFLG:QANHD3,1:"")
EXIT ;Exit
+1 WRITE !
DO ^%ZISC
DO HOME^%ZIS
KILL ;Kill and quit
+1 KILL %H,%ZIS,IZ,POP,QANFLG,QANHD1,QANHD2,QANHD3,QANLINE,QANPG,QANXIT,ZTSK
+2 KILL D,QA,QAN742,QAN7424,QANCS,QB,TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE
+3 QUIT
CASE ;Case Number information
+1 SET QAN7424=$GET(^QA(742.4,QA,0))
+2 SET QANCS(1)=$PIECE(QAN7424,U)
SET QANCS(2)=$PIECE(QAN7424,U,2)
SET QANCS(3)=$PIECE(QAN7424,U,3)
+3 IF QAN7424']""
WRITE !,"Incident Record Number: ",QA," does NOT have data associated with the record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+4 IF QANCS(1)']""
WRITE !,"Incident Record Number: ",QA," does NOT have a Case Number associated with the",!,"record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+5 IF QANCS(2)']""
WRITE !,"Incident Record Number: ",QA," does NOT have a Incident associated with the record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+6 IF QANCS(3)']""
WRITE !,"Incident Record Number: ",QA," does NOT have a Incident Date associated with the",!,"record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+7 FOR QB=0:0
SET QB=$ORDER(^QA(742,"BCS",QA,QB))
if QB'>0
QUIT
DO PAT
if QANXIT
QUIT
+8 QUIT
PAT ;Patient Information
+1 SET QAN742=$GET(^QA(742,QB,0))
+2 IF QAN742']""
WRITE !,"Patient Record Number: ",QB," does NOT have data associated with the record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+3 IF '$DATA(^QA(742.4,"ACN",QB,QA))
SET QANFLG=1
WRITE !,"'ACN' x-ref missing for Patient Record: ",QB," Incident Record: ",QA
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+4 SET QANCS(4)=$PIECE(QAN742,U)
SET QANCS(5)=$PIECE(QAN742,U,2)
SET QANCS(6)=$PIECE(QAN742,U,3)
+5 IF QANCS(4)']""
SET QANFLG=1
WRITE !,"Patient Record Number: ",QA," does NOT have a Patient associated with the record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+6 IF QANCS(5)']""
SET QANFLG=1
WRITE !,"Patient Record Number: ",QA," does NOT have a Patient ID associated with the record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+7 IF QANCS(6)']""
SET QANFLG=1
WRITE !,"Patient Record Number: ",QA," does NOT have a Incident associated with the record!"
if $Y>(IOSL-4)
DO HDH
if QANXIT
QUIT
+8 QUIT
HDH ;Header Prompt
+1 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET QANXIT=1
if QANXIT
QUIT
HDR ;Header
+1 WRITE @IOF
+2 SET QANPG=QANPG+1
SET %H=$HOROLOG
DO YX^%DTC
SET TODAY=Y
+3 WRITE ?69,"Page: ",QANPG,!?58,TODAY,!!
+4 WRITE ?(IOM-$LENGTH(QANHD1)\2),QANHD1,!?(IOM-$LENGTH(QANHD2)\2),QANHD2,!!
+5 FOR IZ=1:1:2
WRITE QANLINE,!
+6 WRITE !
+7 QUIT
