- DG53P621 ;BAY/JAT - Patient File reporting; 6/7/04 7:13pm ; 10/8/04 11:25am
- ;;5.3;Registration;**621,1015**;Aug 13,1993;Build 21
- ;
- REPORT ;
- N X1,X2
- K ^XTMP("DG53P621",$J)
- S X1=DT,X2=90 D C^%DTC
- S ^XTMP("DG53P621",$J,0)=X_"^"_DT_"^Abnormal SSNs"
- 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^DG53P621",ZTDESC="Report of abnormal SSNs"
- .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,DGZERO,DGSSN
- 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 $D(^DPT(DFN,0)) D
- ..S DGZERO=$G(^DPT(DFN,0))
- ..I $E($P(DGZERO,U,1),1,2)="ZZ" Q
- ..S DGSSN=$P(DGZERO,U,9)
- ..I $L(DGSSN)>8 Q ; well-formed ssn, either standard or pseudo
- ..D STORE
- ;
- W !,"Nbr records with abnormal SSN: "_COUNT
- D PRINT
- Q
- ;
- STORE ;
- S COUNT=COUNT+1
- S ^XTMP("DG53P621",$J,DFN)=$E(DGZERO,1,55)
- 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 BAD PATIENT RECORDS: ",COUNT," ***",!!
- S DFN=0
- F S DFN=$O(^XTMP("DG53P621",$J,DFN)) Q:'DFN D Q:DGQUIT
- .I $Y>(IOSL-4) D HEAD
- .S DGZERO=$G(^XTMP("DG53P621",$J,DFN))
- .W ?2,DFN,?13,DGZERO,!
- ;
- 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*621 List of abnormal SSNs",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
- W !
- W !,?2,"DFN",?13,"ZERO NODE",!
- S $P(X,"-",81)="" W X,!
- Q
- DG53P621 ;BAY/JAT - Patient File reporting; 6/7/04 7:13pm ; 10/8/04 11:25am
- +1 ;;5.3;Registration;**621,1015**;Aug 13,1993;Build 21
- +2 ;
- REPORT ;
- +1 NEW X1,X2
- +2 KILL ^XTMP("DG53P621",$JOB)
- +3 SET X1=DT
- SET X2=90
- DO C^%DTC
- +4 SET ^XTMP("DG53P621",$JOB,0)=X_"^"_DT_"^Abnormal SSNs"
- +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^DG53P621"
- SET ZTDESC="Report of abnormal SSNs"
- +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,DGZERO,DGSSN
- +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 $DATA(^DPT(DFN,0))
- Begin DoDot:2
- +9 SET DGZERO=$GET(^DPT(DFN,0))
- +10 IF $EXTRACT($PIECE(DGZERO,U,1),1,2)="ZZ"
- QUIT
- +11 SET DGSSN=$PIECE(DGZERO,U,9)
- +12 ; well-formed ssn, either standard or pseudo
- IF $LENGTH(DGSSN)>8
- QUIT
- +13 DO STORE
- End DoDot:2
- End DoDot:1
- +14 ;
- +15 WRITE !,"Nbr records with abnormal SSN: "_COUNT
- +16 DO PRINT
- +17 QUIT
- +18 ;
- STORE ;
- +1 SET COUNT=COUNT+1
- +2 SET ^XTMP("DG53P621",$JOB,DFN)=$EXTRACT(DGZERO,1,55)
- +3 QUIT
- 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 BAD PATIENT RECORDS: ",COUNT," ***",!!
- +9 SET DFN=0
- +10 FOR
- SET DFN=$ORDER(^XTMP("DG53P621",$JOB,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +11 IF $Y>(IOSL-4)
- DO HEAD
- +12 SET DGZERO=$GET(^XTMP("DG53P621",$JOB,DFN))
- +13 WRITE ?2,DFN,?13,DGZERO,!
- End DoDot:1
- IF DGQUIT
- QUIT
- +14 ;
- +15 IF DGQUIT
- IF $DATA(ZTQUEUED)
- WRITE !!,"Report stopped at user's request"
- QUIT
- +16 IF $GET(DGPG)>0
- IF $EXTRACT(IOST)="C"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF +Y=0
- SET DGQUIT=1
- +17 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +18 QUIT
- +19 ;
- 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*621 List of abnormal SSNs",?70,"Page:",$JUSTIFY(DGPG,5),!
- KILL X
- SET $PIECE(X,"-",81)=""
- WRITE X,!
- +6 WRITE !
- +7 WRITE !,?2,"DFN",?13,"ZERO NODE",!
- +8 SET $PIECE(X,"-",81)=""
- WRITE X,!
- +9 QUIT
