- QAOSPDQ1 ;HISC/DAD-DELINQUENT REVIEWS REPORT ;9/14/92 10:39
- ;;3.0;Occurrence Screen;;09/14/1993
- S QAOSQUIT=0,PAGE=1,X="T",%DT="" D ^%DT X ^DD("DD") S TODAY=Y K UNDL S $P(UNDL,"-",81)="" D HEAD
- I '$D(^TMP($J,"QAOSPDQ")) W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
- S QAOSSERV="" F QAOSSERV(0)=0:0 S QAOSSERV=$O(^TMP($J,"QAOSPDQ",QAOSSERV)) Q:QAOSSERV=""!QAOSQUIT D LOOP1
- EXIT ;
- Q
- LOOP1 ;
- W !!?3,"SERVICE: ",$S(QAOSSERV["~":$P(QAOSSERV,"~",2),1:QAOSSERV),! D CHK
- S QAOSNAME="" F QAOSNAME(0)=0:0 S QAOSNAME=$O(^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME)) Q:QAOSNAME=""!QAOSQUIT F QAOSDATE=0:0 S QAOSDATE=$O(^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE)) Q:QAOSDATE'>0!QAOSQUIT D LOOP2
- Q
- LOOP2 ;
- S QAOS=^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE),Y=QAOSDATE\1 X ^DD("DD") S QAOSDT=Y,Y=$P(QAOS,"^",3) X ^DD("DD") S QAOSPDUE=Y,Y=$P(QAOS,"^",4) X ^DD("DD") S QAOSMDUE=Y,QAOSSCRN=$P(QAOS,"^"),QAOSSN=$P(QAOS,"^",2)
- W !,QAOSNAME,?32,QAOSDT,?45,QAOSSCRN,?53,QAOSPDUE,?68,QAOSMDUE D CHK W !,QAOSSN S (QAOSP,QAOSM)=.0001
- LOOP3 ;
- D PLOOP:QAOSP,MLOOP:QAOSM W ! D CHK G:(QAOSQUIT'>0)&(QAOSP+QAOSM) LOOP3
- Q
- PLOOP ;
- S QAOSP=$O(^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE,"P",QAOSP)) Q:QAOSP'>0 S Y=^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE,"P",QAOSP) X ^DD("DD") W ?53,$S(Y]"":Y,1:" ---")
- Q
- MLOOP ;
- S QAOSM=$O(^TMP($J,"QAOSMDQ",QAOSSERV,QAOSNAME,QAOSDATE,"M",QAOSM)) Q:QAOSM'>0 S Y=^TMP($J,"QAOSMDQ",QAOSSERV,QAOSNAME,QAOSDATE,"M",QAOSM) X ^DD("DD") W ?53,$S(Y]"":Y,1:" ---")
- Q
- CHK ;
- I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD
- Q
- PAUSE ;
- K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
- Q
- HEAD ;
- W:(PAGE>1)!($E(IOST)="C") @IOF
- W !!?31,"DELINQUENT REVIEWS",?68,TODAY,!?31,"AS OF ",TODAY,?68,"PAGE: ",PAGE,!?QAQTART,QAQ2HED S PAGE=PAGE+1 D EN6^QAQAUTL
- W !,"PATIENT",?32,"OCCURRENCE",?45,"SCREEN",?53,"PEER:",?68,"MANAGEMENT:",!,"SSN",?32,"DATE",?53,"DUE DATE",?68,"DUE DATE",!?53,"COMPLETED",?68,"COMPLETED",!,UNDL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPDQ1 1979 printed Mar 13, 2025@21:26:40 Page 2
- QAOSPDQ1 ;HISC/DAD-DELINQUENT REVIEWS REPORT ;9/14/92 10:39
- +1 ;;3.0;Occurrence Screen;;09/14/1993
- +2 SET QAOSQUIT=0
- SET PAGE=1
- SET X="T"
- SET %DT=""
- DO ^%DT
- XECUTE ^DD("DD")
- SET TODAY=Y
- KILL UNDL
- SET $PIECE(UNDL,"-",81)=""
- DO HEAD
- +3 IF '$DATA(^TMP($JOB,"QAOSPDQ"))
- WRITE !!,"NO DATA FOUND FOR THIS REPORT"
- GOTO EXIT
- +4 SET QAOSSERV=""
- FOR QAOSSERV(0)=0:0
- SET QAOSSERV=$ORDER(^TMP($JOB,"QAOSPDQ",QAOSSERV))
- if QAOSSERV=""!QAOSQUIT
- QUIT
- DO LOOP1
- EXIT ;
- +1 QUIT
- LOOP1 ;
- +1 WRITE !!?3,"SERVICE: ",$SELECT(QAOSSERV["~":$PIECE(QAOSSERV,"~",2),1:QAOSSERV),!
- DO CHK
- +2 SET QAOSNAME=""
- FOR QAOSNAME(0)=0:0
- SET QAOSNAME=$ORDER(^TMP($JOB,"QAOSPDQ",QAOSSERV,QAOSNAME))
- if QAOSNAME=""!QAOSQUIT
- QUIT
- FOR QAOSDATE=0:0
- SET QAOSDATE=$ORDER(^TMP($JOB,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE))
- if QAOSDATE'>0!QAOSQUIT
- QUIT
- DO LOOP2
- +3 QUIT
- LOOP2 ;
- +1 SET QAOS=^TMP($JOB,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE)
- SET Y=QAOSDATE\1
- XECUTE ^DD("DD")
- SET QAOSDT=Y
- SET Y=$PIECE(QAOS,"^",3)
- XECUTE ^DD("DD")
- SET QAOSPDUE=Y
- SET Y=$PIECE(QAOS,"^",4)
- XECUTE ^DD("DD")
- SET QAOSMDUE=Y
- SET QAOSSCRN=$PIECE(QAOS,"^")
- SET QAOSSN=$PIECE(QAOS,"^",2)
- +2 WRITE !,QAOSNAME,?32,QAOSDT,?45,QAOSSCRN,?53,QAOSPDUE,?68,QAOSMDUE
- DO CHK
- WRITE !,QAOSSN
- SET (QAOSP,QAOSM)=.0001
- LOOP3 ;
- +1 if QAOSP
- DO PLOOP
- if QAOSM
- DO MLOOP
- WRITE !
- DO CHK
- if (QAOSQUIT'>0)&(QAOSP+QAOSM)
- GOTO LOOP3
- +2 QUIT
- PLOOP ;
- +1 SET QAOSP=$ORDER(^TMP($JOB,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE,"P",QAOSP))
- if QAOSP'>0
- QUIT
- SET Y=^TMP($JOB,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE,"P",QAOSP)
- XECUTE ^DD("DD")
- WRITE ?53,$SELECT(Y]"":Y,1:" ---")
- +2 QUIT
- MLOOP ;
- +1 SET QAOSM=$ORDER(^TMP($JOB,"QAOSMDQ",QAOSSERV,QAOSNAME,QAOSDATE,"M",QAOSM))
- if QAOSM'>0
- QUIT
- SET Y=^TMP($JOB,"QAOSMDQ",QAOSSERV,QAOSNAME,QAOSDATE,"M",QAOSM)
- XECUTE ^DD("DD")
- WRITE ?53,$SELECT(Y]"":Y,1:" ---")
- +2 QUIT
- CHK ;
- +1 IF $Y>(IOSL-6)
- if $EXTRACT(IOST)="C"
- DO PAUSE
- if QAOSQUIT
- QUIT
- DO HEAD
- +2 QUIT
- PAUSE ;
- +1 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
- +2 QUIT
- HEAD ;
- +1 if (PAGE>1)!($EXTRACT(IOST)="C")
- WRITE @IOF
- +2 WRITE !!?31,"DELINQUENT REVIEWS",?68,TODAY,!?31,"AS OF ",TODAY,?68,"PAGE: ",PAGE,!?QAQTART,QAQ2HED
- SET PAGE=PAGE+1
- DO EN6^QAQAUTL
- +3 WRITE !,"PATIENT",?32,"OCCURRENCE",?45,"SCREEN",?53,"PEER:",?68,"MANAGEMENT:",!,"SSN",?32,"DATE",?53,"DUE DATE",?68,"DUE DATE",!?53,"COMPLETED",?68,"COMPLETED",!,UNDL
- +4 QUIT
