- 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 Feb 19, 2025@00:05:59 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