- DG53P604 ;BAY/JAT - Patient File Updat; 6/7/04 7:13pm ; 8/7/04 7:51pm
- ;;5.3;Registration;**604,1015**;Aug 13,1993;Build 21
- ;
- REPORT ;
- N X1,X2
- K ^XTMP("DG53P604",$J)
- S X1=DT,X2=90 D C^%DTC
- S ^XTMP("DG53P604",$J,0)=X_"^"_DT_"^Patient file iens w/decimals"
- I $$DEVICE() D ENTER
- Q
- ;
- ENTER ;
- D READ
- 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^DG53P604",ZTDESC="Patient file iens w/decimals"
- .D ^%ZTLOAD
- .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
- .D HOME^%ZIS
- .S OK=0
- Q OK
- ;
- READ ;
- ;
- N DFN,COUNT,DGSSN,DGWHEN,DGDTCARE
- S (COUNT,DFN)=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 DFN'["." Q
- .I $D(^DPT(DFN,0)) D
- ..S DGSSN=$P($G(^DPT(DFN,0)),U,9)
- ..S DGWHEN=$P($G(^DPT(DFN,0)),U,16)
- ..S DGDTCARE=$P($G(^DPT(DFN,1010.15)),U)
- ..S COUNT=COUNT+1
- ..S ^XTMP("DG53P604",$J,DFN)=DGSSN_"^"_DGWHEN_"^"_DGDTCARE
- ;
- D PRINT
- Q
- ;
- PRINT ;
- U IO
- N DGDDT,DGQUIT,DGPG
- 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 PATIENT RECORDS:",COUNT," ***",!!
- S DFN=0
- F S DFN=$O(^XTMP("DG53P604",$J,DFN)) Q:'DFN D Q:DGQUIT
- .I $Y>(IOSL-4) D HEAD
- .S DGSSN=$P($G(^XTMP("DG53P604",$J,DFN)),U)
- .S DGWHEN=$P($G(^XTMP("DG53P604",$J,DFN)),U,2)
- .S DGWHEN=$$FMTE^XLFDT(DGWHEN,"D")
- .S DGDTCARE=$P($G(^XTMP("DG53P604",$J,DFN)),U,3)
- .S DGDTCARE=$$FMTE^XLFDT(DGDTCARE,"D")
- .W ?2,DFN,?20,DGSSN,?37,DGWHEN,?56,DGDTCARE,!
- ;
- 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*604 Patient File iens w/decimals",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
- W !
- W !,?2,"DFN",?23,"SSN",?37,"Date Record Created",?58,"Most Recent Care Date",!
- S $P(X,"-",81)="" W X,!
- Q
- DG53P604 ;BAY/JAT - Patient File Updat; 6/7/04 7:13pm ; 8/7/04 7:51pm
- +1 ;;5.3;Registration;**604,1015**;Aug 13,1993;Build 21
- +2 ;
- REPORT ;
- +1 NEW X1,X2
- +2 KILL ^XTMP("DG53P604",$JOB)
- +3 SET X1=DT
- SET X2=90
- DO C^%DTC
- +4 SET ^XTMP("DG53P604",$JOB,0)=X_"^"_DT_"^Patient file iens w/decimals"
- +5 IF $$DEVICE()
- DO ENTER
- +6 QUIT
- +7 ;
- ENTER ;
- +1 DO READ
- +2 DO ^%ZISC
- +3 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 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^DG53P604"
- SET ZTDESC="Patient file iens w/decimals"
- +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 ;
- READ ;
- +1 ;
- +2 NEW DFN,COUNT,DGSSN,DGWHEN,DGDTCARE
- +3 SET (COUNT,DFN)=0
- +4 FOR
- SET DFN=$ORDER(^DPT(DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +5 ; merged record
- +6 IF $DATA(^DPT(DFN,-9))
- QUIT
- +7 ; in process of being merged
- +8 IF $PIECE($GET(^DPT(DFN,0)),U)["MERGING INTO"
- QUIT
- +9 IF DFN'["."
- QUIT
- +10 IF $DATA(^DPT(DFN,0))
- Begin DoDot:2
- +11 SET DGSSN=$PIECE($GET(^DPT(DFN,0)),U,9)
- +12 SET DGWHEN=$PIECE($GET(^DPT(DFN,0)),U,16)
- +13 SET DGDTCARE=$PIECE($GET(^DPT(DFN,1010.15)),U)
- +14 SET COUNT=COUNT+1
- +15 SET ^XTMP("DG53P604",$JOB,DFN)=DGSSN_"^"_DGWHEN_"^"_DGDTCARE
- End DoDot:2
- End DoDot:1
- +16 ;
- +17 DO PRINT
- +18 QUIT
- +19 ;
- PRINT ;
- +1 USE IO
- +2 NEW DGDDT,DGQUIT,DGPG
- +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 PATIENT RECORDS:",COUNT," ***",!!
- +9 SET DFN=0
- +10 FOR
- SET DFN=$ORDER(^XTMP("DG53P604",$JOB,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +11 IF $Y>(IOSL-4)
- DO HEAD
- +12 SET DGSSN=$PIECE($GET(^XTMP("DG53P604",$JOB,DFN)),U)
- +13 SET DGWHEN=$PIECE($GET(^XTMP("DG53P604",$JOB,DFN)),U,2)
- +14 SET DGWHEN=$$FMTE^XLFDT(DGWHEN,"D")
- +15 SET DGDTCARE=$PIECE($GET(^XTMP("DG53P604",$JOB,DFN)),U,3)
- +16 SET DGDTCARE=$$FMTE^XLFDT(DGDTCARE,"D")
- +17 WRITE ?2,DFN,?20,DGSSN,?37,DGWHEN,?56,DGDTCARE,!
- End DoDot:1
- IF DGQUIT
- QUIT
- +18 ;
- +19 IF DGQUIT
- IF $DATA(ZTQUEUED)
- WRITE !!,"Report stopped at user's request"
- QUIT
- +20 IF $GET(DGPG)>0
- IF $EXTRACT(IOST)="C"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF +Y=0
- SET DGQUIT=1
- +21 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +22 QUIT
- +23 ;
- 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*604 Patient File iens w/decimals",?70,"Page:",$JUSTIFY(DGPG,5),!
- KILL X
- SET $PIECE(X,"-",81)=""
- WRITE X,!
- +6 WRITE !
- +7 WRITE !,?2,"DFN",?23,"SSN",?37,"Date Record Created",?58,"Most Recent Care Date",!
- +8 SET $PIECE(X,"-",81)=""
- WRITE X,!
- +9 QUIT
