DG53P629 ;BAY/JAT - Patient File reporting; 6/7/04 7:13pm ; 12/11/04 10:37pm
;;5.3;Registration;**629**;Aug 13,1993
;
REPORT ;
N X1,X2
K ^XTMP("DG53P629",$J)
S X1=DT,X2=90 D C^%DTC
S ^XTMP("DG53P629",$J,0)=X_"^"_DT_"^Possible missing patients"
I $$DEVICE() D ENTER
Q
;
ENTER ;
;
D READFILE
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
DEVICE() ;
;Description: allows the user to select a device.
;
;Output:
; Function Value - Returns 0 if the user decides not to print or to
; queue the report, 1 otherwise.
;
N OK,IOP,POP,%ZIS
S OK=1
S %ZIS="MQ"
D ^%ZIS
S:POP OK=0
D:OK&$D(IO("Q"))
.N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
.S ZTRTN="ENTER^DG53P629",ZTDESC="Report of possible missing patients"
.D ^%ZTLOAD
.W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
.D HOME^%ZIS
.S OK=0
Q OK
;
READFILE ;
N DFN,COUNT,DGDATE,DGSRCE,DGCITY,DGSTAT
S (DFN,COUNT)=0
F S DFN=$O(^DPT(DFN)) Q:'DFN D
.; merged record
.I $D(^DPT(DFN,-9)) Q
.; in process of being merged
.I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q
.I $P($G(^DPT(DFN,.15)),U,3)!($P($G(^DPT(DFN,"INE")),U,7))!($P($G(^DPT(DFN,"INE")),U,8))!($P($G(^DPT(DFN,"INE")),U,7)) D
..S DGDATE=$P($G(^DPT(DFN,.15)),U,3)
..S DGSRCE=$P($G(^DPT(DFN,"INE")),U,7)
..S DGCITY=$P($G(^DPT(DFN,"INE")),U,8)
..S DGSTAT=$P($G(^DPT(DFN,"INE")),U,9)
..D STORE
;
W !,"Nbr possible missing patients: "_COUNT
D PRINT
Q
;
STORE ;
S COUNT=COUNT+1
S ^XTMP("DG53P629",$J,DFN)=DGDATE_U_DGSRCE_U_DGCITY_U_DGSTAT
Q
PRINT ;
U IO
N DGDDT,DGQUIT,DGPG,DGDATA,DGTEXT
S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
S (DGQUIT,DGPG)=0
D HEAD
I '$G(COUNT) D Q
.W !!!,?20,"*** No records to report ***"
W !!,"*** COUNT OF POSSIBLE MISSING PATIENTS: ",COUNT," ***",!!
S DFN=0
F S DFN=$O(^XTMP("DG53P629",$J,DFN)) Q:'DFN D Q:DGQUIT
.I $Y>(IOSL-4) D HEAD
.S DGDATA=$G(^XTMP("DG53P629",$J,DFN))
.S DGDATE=$P(DGDATA,U),DGSRCE=$P(DGDATA,U,2),DGCITY=$P(DGDATA,U,3),DGSTAT=$P(DGDATA,U,4)
.S Y=$P(DGDATE,".") D DD^%DT S DGDATE=Y
.S DGSRCE=$S(DGSRCE=1:"VAMC",DGSRCE=2:"RO",DGSRCE=3:"RPC",1:"")
.I DGSTAT>0 S DGSTAT=$P($G(^DIC(5,DGSTAT,0)),U)
.W ?2,DFN,?13,DGDATE,?27,DGSRCE,?34,DGCITY,?53,DGSTAT,!
.I '$D(^DPT(DFN,.16)) W ! Q
.S DGTEXT=0
.F S DGTEXT=$O(^DPT(DFN,.16,DGTEXT)) Q:'DGTEXT D
..W ?13,$G(^DPT(DFN,.16,DGTEXT,0)),!
.W !
;
I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q
I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
HEAD ;
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
Q:DGQUIT
S DGPG=$G(DGPG)+1
W @IOF,!,DGDDT,?15,"DG*5.3*629 List of possible missing patients",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
W !
W !,?2,"DFN",?13,"DATE",?26,"SOURCE",?34,"CITY",?53,"STATE",!!
S $P(X,"-",81)="" W X,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P629 2961 printed Dec 13, 2024@02:39:56 Page 2
DG53P629 ;BAY/JAT - Patient File reporting; 6/7/04 7:13pm ; 12/11/04 10:37pm
+1 ;;5.3;Registration;**629**;Aug 13,1993
+2 ;
REPORT ;
+1 NEW X1,X2
+2 KILL ^XTMP("DG53P629",$JOB)
+3 SET X1=DT
SET X2=90
DO C^%DTC
+4 SET ^XTMP("DG53P629",$JOB,0)=X_"^"_DT_"^Possible missing patients"
+5 IF $$DEVICE()
DO ENTER
+6 QUIT
+7 ;
ENTER ;
+1 ;
+2 DO READFILE
+3 DO ^%ZISC
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
DEVICE() ;
+1 ;Description: allows the user to select a device.
+2 ;
+3 ;Output:
+4 ; Function Value - Returns 0 if the user decides not to print or to
+5 ; queue the report, 1 otherwise.
+6 ;
+7 NEW OK,IOP,POP,%ZIS
+8 SET OK=1
+9 SET %ZIS="MQ"
+10 DO ^%ZIS
+11 if POP
SET OK=0
+12 if OK&$DATA(IO("Q"))
Begin DoDot:1
+13 NEW ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
+14 SET ZTRTN="ENTER^DG53P629"
SET ZTDESC="Report of possible missing patients"
+15 DO ^%ZTLOAD
+16 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+17 DO HOME^%ZIS
+18 SET OK=0
End DoDot:1
+19 QUIT OK
+20 ;
READFILE ;
+1 NEW DFN,COUNT,DGDATE,DGSRCE,DGCITY,DGSTAT
+2 SET (DFN,COUNT)=0
+3 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+4 ; merged record
+5 IF $DATA(^DPT(DFN,-9))
QUIT
+6 ; in process of being merged
+7 IF $PIECE($GET(^DPT(DFN,0)),U)["MERGING INTO"
QUIT
+8 IF $PIECE($GET(^DPT(DFN,.15)),U,3)!($PIECE($GET(^DPT(DFN,"INE")),U,7))!($PIECE($GET(^DPT(DFN,"INE")),U,8))!($PIECE($GET(^DPT(DFN,"INE")),U,7))
Begin DoDot:2
+9 SET DGDATE=$PIECE($GET(^DPT(DFN,.15)),U,3)
+10 SET DGSRCE=$PIECE($GET(^DPT(DFN,"INE")),U,7)
+11 SET DGCITY=$PIECE($GET(^DPT(DFN,"INE")),U,8)
+12 SET DGSTAT=$PIECE($GET(^DPT(DFN,"INE")),U,9)
+13 DO STORE
End DoDot:2
End DoDot:1
+14 ;
+15 WRITE !,"Nbr possible missing patients: "_COUNT
+16 DO PRINT
+17 QUIT
+18 ;
STORE ;
+1 SET COUNT=COUNT+1
+2 SET ^XTMP("DG53P629",$JOB,DFN)=DGDATE_U_DGSRCE_U_DGCITY_U_DGSTAT
+3 QUIT
PRINT ;
+1 USE IO
+2 NEW DGDDT,DGQUIT,DGPG,DGDATA,DGTEXT
+3 SET DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
+4 SET (DGQUIT,DGPG)=0
+5 DO HEAD
+6 IF '$GET(COUNT)
Begin DoDot:1
+7 WRITE !!!,?20,"*** No records to report ***"
End DoDot:1
QUIT
+8 WRITE !!,"*** COUNT OF POSSIBLE MISSING PATIENTS: ",COUNT," ***",!!
+9 SET DFN=0
+10 FOR
SET DFN=$ORDER(^XTMP("DG53P629",$JOB,DFN))
if 'DFN
QUIT
Begin DoDot:1
+11 IF $Y>(IOSL-4)
DO HEAD
+12 SET DGDATA=$GET(^XTMP("DG53P629",$JOB,DFN))
+13 SET DGDATE=$PIECE(DGDATA,U)
SET DGSRCE=$PIECE(DGDATA,U,2)
SET DGCITY=$PIECE(DGDATA,U,3)
SET DGSTAT=$PIECE(DGDATA,U,4)
+14 SET Y=$PIECE(DGDATE,".")
DO DD^%DT
SET DGDATE=Y
+15 SET DGSRCE=$SELECT(DGSRCE=1:"VAMC",DGSRCE=2:"RO",DGSRCE=3:"RPC",1:"")
+16 IF DGSTAT>0
SET DGSTAT=$PIECE($GET(^DIC(5,DGSTAT,0)),U)
+17 WRITE ?2,DFN,?13,DGDATE,?27,DGSRCE,?34,DGCITY,?53,DGSTAT,!
+18 IF '$DATA(^DPT(DFN,.16))
WRITE !
QUIT
+19 SET DGTEXT=0
+20 FOR
SET DGTEXT=$ORDER(^DPT(DFN,.16,DGTEXT))
if 'DGTEXT
QUIT
Begin DoDot:2
+21 WRITE ?13,$GET(^DPT(DFN,.16,DGTEXT,0)),!
End DoDot:2
+22 WRITE !
End DoDot:1
if DGQUIT
QUIT
+23 ;
+24 IF DGQUIT
if $DATA(ZTQUEUED)
WRITE !!,"Report stopped at user's request"
QUIT
+25 IF $GET(DGPG)>0
IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET DGQUIT=1
+26 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+27 QUIT
+28 ;
HEAD ;
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,DGQUIT)=1
QUIT
+2 IF $GET(DGPG)>0
IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET DGQUIT=1
+3 if DGQUIT
QUIT
+4 SET DGPG=$GET(DGPG)+1
+5 WRITE @IOF,!,DGDDT,?15,"DG*5.3*629 List of possible missing patients",?70,"Page:",$JUSTIFY(DGPG,5),!
KILL X
SET $PIECE(X,"-",81)=""
WRITE X,!
+6 WRITE !
+7 WRITE !,?2,"DFN",?13,"DATE",?26,"SOURCE",?34,"CITY",?53,"STATE",!!
+8 SET $PIECE(X,"-",81)=""
WRITE X,!
+9 QUIT
