ANRVRP8 ;BIRM/LDT - VIST ROSTER OUTPATIENT APPOINTMENTS ; 17 Feb 98 / 2:26 PM
;;4.0; Visual Impairment Service Team ;;12 Jun 98
EN1 ;Entry point for Roster Outpatient Appointment.
W @IOF,!!,"OUTPATIENT APPOINTMENT LIST",!!,"The right margin for this report is 132.",!!
D SEL1 G:SEL="^" QUIT
BDT W ! S %DT="AEX",%DT("A")="BEGINNING date for report: " D ^%DT K %DT G:Y<0 QUIT S BDT=Y
EDT S %DT="AEX",%DT(0)=BDT,%DT("A")="ENDING date for report: " D ^%DT K %DT G:Y<0 QUIT S EDT=Y
D SEL2 G:'$D(ANRVLP) QUIT
DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!!" G QUIT
I $D(IO("Q")) K IO("Q") S ZTDESC="VIST ROSTER OUTPATIENT APPOINTMENTS",ZTRTN="DEQ^ANRVRP8" S:$D(ANRVLP) ZTSAVE("ANRVLP(")="" F G="BDT","EDT","SEL" S:$D(@G) ZTSAVE(G)=""
I D ^%ZTLOAD K ZTSK G QUIT
U IO
DEQ ;Entry point when queued.
K ^TMP("ANRV",$J)
S ANRVP=0 F S ANRVP=$O(ANRVLP(ANRVP)) Q:'ANRVP S DFN=$P($G(^ANRV(2040,ANRVP,0)),U),VASD("T")=EDT,VASD("F")=BDT D 9^VADPT,SETTMP
S HDR="VIST ROSTER OUTPATIENT APPOINTMENTS"
S (PG,QFLG)=0,$P(LN,"-",133)="" D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S HDT=Y D HDR
I '$D(^TMP("ANRV",$J)) W !,"NO DATA TO PRINT!" G QUIT
D REPORT
;
QUIT K %,%H,%I,%T,%Y,ANRVP,ANRV,ANRVAP,ANRVLP,APP,BDT,DFN,EDT,HDR,HDT,JJ,LN,NAME,NN,PG,POP,QFLG,RVDT,SEL,SUB1,SUB2,X,Y,XX,XXX D KVAR^VADPT,KVA^VADPT
W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
SETTMP ;Set TMP global
I $D(^UTILITY("VASD",$J)) D
.I SEL="P" S SUB1=VADM(1),^TMP("ANRV",$J,SUB1,0)=VADM(1)_U_$P(VADM(2),U,2) D
..S RVDT=$O(^ANRV(2040,ANRVP,6," "),-1) S:RVDT]"" RVDT=$G(^ANRV(2040,ANRVP,6,RVDT,0)) I RVDT]"" S Y=$P(RVDT,U) X ^DD("DD") S $P(^TMP("ANRV",$J,SUB1,0),U,3)=Y,$P(^(0),U,4)=$P(RVDT,U,2)
..S APP=0 F S APP=$O(^UTILITY("VASD",$J,APP)) Q:'APP S ^TMP("ANRV",$J,SUB1,APP)=$G(^UTILITY("VASD",$J,APP,"E"))
.I SEL="D" S SUB2=VADM(1),APP=0 F S APP=$O(^UTILITY("VASD",$J,APP)) Q:'APP S %DT="NTX",X=$P(^UTILITY("VASD",$J,APP,"E"),U) D ^%DT S SUB1=Y,^TMP("ANRV",$J,SUB1,SUB2,0)=VADM(1)_U_$P(VADM(2),U,2) D
..S RVDT=$O(^ANRV(2040,ANRVP,6," "),-1) S:RVDT]"" RVDT=$G(^ANRV(2040,ANRVP,6,RVDT,0)) I RVDT]"" S Y=$P(RVDT,U) X ^DD("DD") S $P(^TMP("ANRV",$J,SUB1,SUB2,0),U,3)=Y,$P(^(0),U,4)=$P(RVDT,U,2)
..S ^TMP("ANRV",$J,SUB1,SUB2,APP)=$G(^UTILITY("VASD",$J,APP,"E"))
Q
;
HDR ;Report header
I $E(IOST)="C",PG>0 S DIR(0)="E" D ^DIR K DIR I 'Y S QFLG=1 Q
S PG=PG+1 W:$Y!($E(IOST)="C") @IOF Q:(PG>1)&($E(IOST)="C") W !,HDR," FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,?100,"Page ",PG
W !,"NAME",?32,"SSN",?45,"LAST ANNUAL REVIEW",?65,"STATUS",?81,"APPT. DATE/TIME",?100,"CLINIC",!,LN
Q
;
REPORT ;Print Report
I SEL="P" S NAME="" F S NAME=$O(^TMP("ANRV",$J,NAME)) Q:NAME="" D D:$Y+4>IOSL HDR Q:QFLG
.F XX=1:1:4 S ANRV(XX)=$P($G(^TMP("ANRV",$J,NAME,0)),U,XX)
.W !!,ANRV(1),?32,ANRV(2),?48,ANRV(3),?65,$S(ANRV(4)="035":"COMPLETE (035)",ANRV(4)="036":"DECLINED (036)",ANRV(4)="037":"NO SHOW (037)",1:"")
.S NN=0 F S NN=$O(^TMP("ANRV",$J,NAME,NN)) Q:'NN D
..F XXX=1:1:4 S ANRVAP(XXX)=$P($G(^TMP("ANRV",$J,NAME,NN)),U,XXX)
..W ?81,ANRVAP(1),?100,ANRVAP(2),!
I SEL="D" S APP=0,NAME="" F S APP=$O(^TMP("ANRV",$J,APP)) Q:'APP F S NAME=$O(^TMP("ANRV",$J,APP,NAME)) Q:NAME="" D D:$Y+5>IOSL HDR Q:QFLG
.F XX=1:1:4 S ANRV(XX)=$P($G(^TMP("ANRV",$J,APP,NAME,0)),U,XX)
.W !!,ANRV(1),?32,ANRV(2),?48,ANRV(3),?65,$S(ANRV(4)="035":"COMPLETE (035)",ANRV(4)="036":"DECLINED (036)",ANRV(4)="037":"NO SHOW (037)",1:"")
.S NN=0 F S NN=$O(^TMP("ANRV",$J,APP,NAME,NN)) Q:'NN D
..F XXX=1:1:4 S ANRVAP(XXX)=$P($G(^TMP("ANRV",$J,APP,NAME,NN)),U,XXX)
..W ?81,ANRVAP(1),?100,ANRVAP(2),!
Q
SEL1 W !!,"Do you want to sort by (P)atient or (D)ate/time of appointment?",!
S DIR(0)="SAOBM^P:PATIENT;D:DATE/TIME",DIR("A")="Choose P or D: ",DIR("?")="^D HELPSEL^ANRVRP8" D ^DIR K DIR
S SEL=Y S:SEL="" SEL="^" G:SEL="^" QUIT2 Q
SEL2 W !!,"Do you want to list outpatient appointments for:",!?7,"(A)ll patients, or",!?7,"(S)elect patients.",!
S DIR(0)="SAOBM^A:ALL;S:SELECT",DIR("A")="Choose A or S: ",DIR("?")="^D HELP2^ANRVRP8" D ^DIR K DIR
I Y="A" G SETLP
ASKPT ;Ask for selected patients.
W !
S DIC="^ANRV(2040,",DIC(0)="QEAM",DIC("S")="I $P($G(^ANRV(2040,+Y,13)),U,2)'=""I""" D ^DIC K DIC I Y<0 Q
S ANRVLP(+Y)="" G ASKPT
Q
QUIT2 K %,X,Y Q
SETLP ;Set ANRVLP for all patients who are not inactive for AMIS
S JJ=0 F S JJ=$O(^ANRV(2040,JJ)) Q:'JJ I $P($G(^ANRV(2040,JJ,13)),U,2)'="I" S ANRVLP(JJ)=""
Q
HELPSEL ;
W !!,"Enter:",!?7,"""P"" to sort outpatient appointments by patient in alphabetic order.",!?7,"""D"" to sort outpatient appointments by date/time of clinic appointment.",!?7,"""^"" or <return> to halt." Q
HELP2 ;
W !!,"Enter:",!?7,"""A"" to list ALL patients from the VIST ROSTER file with",!?11,"outpatient appointments.",!?7,"""S"" to select only specific patients.",!?7,"""^"" or <return> to halt." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVRP8 4935 printed Nov 22, 2024@17:55:52 Page 2
ANRVRP8 ;BIRM/LDT - VIST ROSTER OUTPATIENT APPOINTMENTS ; 17 Feb 98 / 2:26 PM
+1 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
EN1 ;Entry point for Roster Outpatient Appointment.
+1 WRITE @IOF,!!,"OUTPATIENT APPOINTMENT LIST",!!,"The right margin for this report is 132.",!!
+2 DO SEL1
if SEL="^"
GOTO QUIT
BDT WRITE !
SET %DT="AEX"
SET %DT("A")="BEGINNING date for report: "
DO ^%DT
KILL %DT
if Y<0
GOTO QUIT
SET BDT=Y
EDT SET %DT="AEX"
SET %DT(0)=BDT
SET %DT("A")="ENDING date for report: "
DO ^%DT
KILL %DT
if Y<0
GOTO QUIT
SET EDT=Y
+1 DO SEL2
if '$DATA(ANRVLP)
GOTO QUIT
DEV KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
GOTO QUIT
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="VIST ROSTER OUTPATIENT APPOINTMENTS"
SET ZTRTN="DEQ^ANRVRP8"
if $DATA(ANRVLP)
SET ZTSAVE("ANRVLP(")=""
FOR G="BDT","EDT","SEL"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 IF $TEST
DO ^%ZTLOAD
KILL ZTSK
GOTO QUIT
+3 USE IO
DEQ ;Entry point when queued.
+1 KILL ^TMP("ANRV",$JOB)
+2 SET ANRVP=0
FOR
SET ANRVP=$ORDER(ANRVLP(ANRVP))
if 'ANRVP
QUIT
SET DFN=$PIECE($GET(^ANRV(2040,ANRVP,0)),U)
SET VASD("T")=EDT
SET VASD("F")=BDT
DO 9^VADPT
DO SETTMP
+3 SET HDR="VIST ROSTER OUTPATIENT APPOINTMENTS"
+4 SET (PG,QFLG)=0
SET $PIECE(LN,"-",133)=""
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
SET HDT=Y
DO HDR
+5 IF '$DATA(^TMP("ANRV",$JOB))
WRITE !,"NO DATA TO PRINT!"
GOTO QUIT
+6 DO REPORT
+7 ;
QUIT KILL %,%H,%I,%T,%Y,ANRVP,ANRV,ANRVAP,ANRVLP,APP,BDT,DFN,EDT,HDR,HDT,JJ,LN,NAME,NN,PG,POP,QFLG,RVDT,SEL,SUB1,SUB2,X,Y,XX,XXX
DO KVAR^VADPT
DO KVA^VADPT
+1 if $EXTRACT(IOST)'="C"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;
SETTMP ;Set TMP global
+1 IF $DATA(^UTILITY("VASD",$JOB))
Begin DoDot:1
+2 IF SEL="P"
SET SUB1=VADM(1)
SET ^TMP("ANRV",$JOB,SUB1,0)=VADM(1)_U_$PIECE(VADM(2),U,2)
Begin DoDot:2
+3 SET RVDT=$ORDER(^ANRV(2040,ANRVP,6," "),-1)
if RVDT]""
SET RVDT=$GET(^ANRV(2040,ANRVP,6,RVDT,0))
IF RVDT]""
SET Y=$PIECE(RVDT,U)
XECUTE ^DD("DD")
SET $PIECE(^TMP("ANRV",$JOB,SUB1,0),U,3)=Y
SET $PIECE(^(0),U,4)=$PIECE(RVDT,U,2)
+4 SET APP=0
FOR
SET APP=$ORDER(^UTILITY("VASD",$JOB,APP))
if 'APP
QUIT
SET ^TMP("ANRV",$JOB,SUB1,APP)=$GET(^UTILITY("VASD",$JOB,APP,"E"))
End DoDot:2
+5 IF SEL="D"
SET SUB2=VADM(1)
SET APP=0
FOR
SET APP=$ORDER(^UTILITY("VASD",$JOB,APP))
if 'APP
QUIT
SET %DT="NTX"
SET X=$PIECE(^UTILITY("VASD",$JOB,APP,"E"),U)
DO ^%DT
SET SUB1=Y
SET ^TMP("ANRV",$JOB,SUB1,SUB2,0)=VADM(1)_U_$PIECE(VADM(2),U,2)
Begin DoDot:2
+6 SET RVDT=$ORDER(^ANRV(2040,ANRVP,6," "),-1)
if RVDT]""
SET RVDT=$GET(^ANRV(2040,ANRVP,6,RVDT,0))
IF RVDT]""
SET Y=$PIECE(RVDT,U)
XECUTE ^DD("DD")
SET $PIECE(^TMP("ANRV",$JOB,SUB1,SUB2,0),U,3)=Y
SET $PIECE(^(0),U,4)=$PIECE(RVDT,U,2)
+7 SET ^TMP("ANRV",$JOB,SUB1,SUB2,APP)=$GET(^UTILITY("VASD",$JOB,APP,"E"))
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
HDR ;Report header
+1 IF $EXTRACT(IOST)="C"
IF PG>0
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+2 SET PG=PG+1
if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
if (PG>1)&($EXTRACT(IOST)="C")
QUIT
WRITE !,HDR," FROM "
SET Y=BDT
XECUTE ^DD("DD")
WRITE Y," TO "
SET Y=EDT
XECUTE ^DD("DD")
WRITE Y,?100,"Page ",PG
+3 WRITE !,"NAME",?32,"SSN",?45,"LAST ANNUAL REVIEW",?65,"STATUS",?81,"APPT. DATE/TIME",?100,"CLINIC",!,LN
+4 QUIT
+5 ;
REPORT ;Print Report
+1 IF SEL="P"
SET NAME=""
FOR
SET NAME=$ORDER(^TMP("ANRV",$JOB,NAME))
if NAME=""
QUIT
Begin DoDot:1
+2 FOR XX=1:1:4
SET ANRV(XX)=$PIECE($GET(^TMP("ANRV",$JOB,NAME,0)),U,XX)
+3 WRITE !!,ANRV(1),?32,ANRV(2),?48,ANRV(3),?65,$SELECT(ANRV(4)="035":"COMPLETE (035)",ANRV(4)="036":"DECLINED (036)",ANRV(4)="037":"NO SHOW (037)",1:"")
+4 SET NN=0
FOR
SET NN=$ORDER(^TMP("ANRV",$JOB,NAME,NN))
if 'NN
QUIT
Begin DoDot:2
+5 FOR XXX=1:1:4
SET ANRVAP(XXX)=$PIECE($GET(^TMP("ANRV",$JOB,NAME,NN)),U,XXX)
+6 WRITE ?81,ANRVAP(1),?100,ANRVAP(2),!
End DoDot:2
End DoDot:1
if $Y+4>IOSL
DO HDR
if QFLG
QUIT
+7 IF SEL="D"
SET APP=0
SET NAME=""
FOR
SET APP=$ORDER(^TMP("ANRV",$JOB,APP))
if 'APP
QUIT
FOR
SET NAME=$ORDER(^TMP("ANRV",$JOB,APP,NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 FOR XX=1:1:4
SET ANRV(XX)=$PIECE($GET(^TMP("ANRV",$JOB,APP,NAME,0)),U,XX)
+9 WRITE !!,ANRV(1),?32,ANRV(2),?48,ANRV(3),?65,$SELECT(ANRV(4)="035":"COMPLETE (035)",ANRV(4)="036":"DECLINED (036)",ANRV(4)="037":"NO SHOW (037)",1:"")
+10 SET NN=0
FOR
SET NN=$ORDER(^TMP("ANRV",$JOB,APP,NAME,NN))
if 'NN
QUIT
Begin DoDot:2
+11 FOR XXX=1:1:4
SET ANRVAP(XXX)=$PIECE($GET(^TMP("ANRV",$JOB,APP,NAME,NN)),U,XXX)
+12 WRITE ?81,ANRVAP(1),?100,ANRVAP(2),!
End DoDot:2
End DoDot:1
if $Y+5>IOSL
DO HDR
if QFLG
QUIT
+13 QUIT
SEL1 WRITE !!,"Do you want to sort by (P)atient or (D)ate/time of appointment?",!
+1 SET DIR(0)="SAOBM^P:PATIENT;D:DATE/TIME"
SET DIR("A")="Choose P or D: "
SET DIR("?")="^D HELPSEL^ANRVRP8"
DO ^DIR
KILL DIR
+2 SET SEL=Y
if SEL=""
SET SEL="^"
if SEL="^"
GOTO QUIT2
QUIT
SEL2 WRITE !!,"Do you want to list outpatient appointments for:",!?7,"(A)ll patients, or",!?7,"(S)elect patients.",!
+1 SET DIR(0)="SAOBM^A:ALL;S:SELECT"
SET DIR("A")="Choose A or S: "
SET DIR("?")="^D HELP2^ANRVRP8"
DO ^DIR
KILL DIR
+2 IF Y="A"
GOTO SETLP
ASKPT ;Ask for selected patients.
+1 WRITE !
+2 SET DIC="^ANRV(2040,"
SET DIC(0)="QEAM"
SET DIC("S")="I $P($G(^ANRV(2040,+Y,13)),U,2)'=""I"""
DO ^DIC
KILL DIC
IF Y<0
QUIT
+3 SET ANRVLP(+Y)=""
GOTO ASKPT
+4 QUIT
QUIT2 KILL %,X,Y
QUIT
SETLP ;Set ANRVLP for all patients who are not inactive for AMIS
+1 SET JJ=0
FOR
SET JJ=$ORDER(^ANRV(2040,JJ))
if 'JJ
QUIT
IF $PIECE($GET(^ANRV(2040,JJ,13)),U,2)'="I"
SET ANRVLP(JJ)=""
+2 QUIT
HELPSEL ;
+1 WRITE !!,"Enter:",!?7,"""P"" to sort outpatient appointments by patient in alphabetic order.",!?7,"""D"" to sort outpatient appointments by date/time of clinic appointment.",!?7,"""^"" or <return> to halt."
QUIT
HELP2 ;
+1 WRITE !!,"Enter:",!?7,"""A"" to list ALL patients from the VIST ROSTER file with",!?11,"outpatient appointments.",!?7,"""S"" to select only specific patients.",!?7,"""^"" or <return> to halt."
QUIT
