- DGPFRFA1 ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT CONT. ; 1/21/04 5:14pm
- ;;5.3;Registration;**425,554,1007,1015**;Aug 13, 1993;Build 21
- ;
- ;This routine will compile and produce the FLAG ASSIGNMENT REPORT.
- ;This routine will be used to display or print all of the patient
- ; assignments for Category I and Category II Patient Record Flags.
- ;
- ;All sort input was created in routine DGPFRFA.
- ; Input: The following array contains the sort var's:
- ; DGSORT("DGCAT") = category reporting on (I, II, or (B)oth)
- ; DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on
- ; = IEN of a (S)ingle Flag (#26.11)/(#26.15)
- ; example: "1;DGPF(26.15,"
- ; DGSORT("DGBEG") = Beginning date to report on
- ; DGSORT("DGEND") = Ending date to report on
- ;
- ; Output: A formatted report of Record Flag Assignments to patients.
- ;
- ;- no direct entry
- QUIT
- ;
- START ; compile and print report
- I $E(IOST)="C" D WAIT^DICD
- N DGLIST
- S DGLIST=$NA(^TMP("DGPFRFA1",$J))
- K @DGLIST
- D LOOP(.DGSORT)
- D PRINT(.DGSORT,DGLIST)
- D EXIT
- Q
- ;
- LOOP(DGSORT) ;use sort var's for record searching to build list
- ; Input:
- ; DGSORT - array of user selected report parameters
- ;
- ; Output:
- ; ^TMP("DGPFRFA1",$J) - temp global containing report output
- ;
- N DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGDFNLST
- N DGC,DGF,DGX,DGQ,DGFG,DGSUB,DGCNT
- S (DGQ,DGFG,DGSUB,DGCNT)=0
- S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
- S DGC=$S(+DGCAT=3:0,1:+DGCAT) ;0 = both categories (National & Local)
- S:DGC DGC=$S(DGC=1:26.15,1:26.11)
- S DGF=$P(DGFLAG,U) ;"A"=all flags - "5;DGPF(26.11," is selection
- ; re-seed var to start looping before actual selection
- D:+DGF
- . S DGSUB=$O(^DGPF(26.13,"AFLAG",DGF),-1) ;previous value or NULL
- ; ex. DGSUB="5;DGPF(26.11," to loop ^DGPF(26.13,"AFLAG",DGSUB,dfn,ien
- ;
- S (DGDFN,DGIEN)=""
- F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ
- . I DGC,DGSUB'[DGC Q ;not correct file based on category
- . I +DGF,DGSUB'[DGF S:DGSUB>DGF DGQ=1 Q ;don't setup or quit loop
- . K DGDFNLST
- . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) ;get list of dfn's
- . Q:'DGCNT
- . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
- . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""
- . . D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
- K DGDFNLST
- Q
- ;
- BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
- ; Input:
- ; DGSORT - array of user selected report parameters
- ; DGDFN - ien of patient in PATIENT (#2) file
- ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
- ; DGLIST - temp global name used for report list
- ;
- ; Output:
- ; ^TMP("DGPFRFA1",$J) - temp global containing report output
- ;
- N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGFG
- S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV)=""
- K DGPFA,DGPFAH,DGPFPAT
- ;retrieve a single assign record
- Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
- ;retrieve initial history assign record
- Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
- ;-- get 'initial assignment' date
- S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
- Q:'DGPFAH("INITASSIGN")
- S DGINIT=+DGPFAH("INITASSIGN")
- I DGINIT>DGBEG&($P(DGINIT,".")'>DGEND) D
- . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
- . S DGCATG=$S(DGSUB[26.15:1,1:2)
- . S DGFG=$P(DGPFA("FLAG"),U,2)
- . S DGNAME=DGPFPAT("NAME")
- . S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
- . I +DGPFA("REVIEWDT") D
- .. S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
- . E S DGREV="N/A"
- . S DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
- . S DGLINE=DGLINE_U_$P(DGPFA("OWNER"),U,2)
- . S @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
- K DGPFA,DGPFAH,DGPFPAT
- Q
- ;
- PRINT(DGSORT,DGLIST) ;output report
- ; Input:
- ; DGSORT - array of user selected report parameters
- ; DGLIST - temp global name used for report list
- ;
- ; Output: Formated report to user selected device
- ;
- N DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,X,Y,DGPAGE,DGDT,DGCNT,DGOFG,DGGRAND,DGLINE
- S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",80)=""
- S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
- I $O(@DGLIST@(""))="" D Q
- . S DGCAT=+DGSORT("DGCAT")
- . S DGFG=$S(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$P(DGSORT("DGFLAG"),U,2))
- . D HEAD
- . W !!," >>> No Record Flag Assignments were found using the report criteria."
- ; loop and print report
- S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
- F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
- . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
- .. I DGFG'=DGOFG D
- ... D:DGCNT SUB(.DGCNT,1)
- ... D HEAD
- ... S DGOFG=DGFG,DGCNT=0
- .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
- ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
- .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
- .... D:$Y>(IOSL-4) HEAD
- .... Q:DGQ
- .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
- .... W !,$E(DGNAM,1,20),?22,$P(DGSTR,U),?33,$P(DGSTR,U,2),?43,$P(DGSTR,U,3),?53,$P(DGSTR,U,4),?63,$E($P(DGSTR,U,5),1,17)
- . Q:DGQ
- . I DGCNT D
- .. D SUB(.DGCNT,1)
- .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2) ;only if (A)ll flags
- .. S DGOFG="",DGCNT=0
- ;
- ;Shutdown if stop task requested
- I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
- ;
- I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories
- . S DGCAT=3,DGFG="All Flags",DGGRAND=1
- . D HEAD
- . W !!,"REPORT SUMMARY:",!,"---------------"
- . F DGCAT=1,2,3 D
- .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT))
- .. W:DGCAT=3 !?39,"-------"
- .. W !,"Total Assignments for Category "
- .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
- .. W ?40,$J(+$G(DGCNT(DGCAT)),6)
- ;
- W !!,"<End of Report>"
- Q
- ;
- PAUSE(DGQ) ; pause screen display
- ; Input:
- ; DGQ - var used to quit report processing to user CRT
- ; Output:
- ; DGQ - passed by reference - 0 = Continue, 1 = Quit
- ;
- I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
- Q
- ;
- SUB(CNT,TYP) ; print sub-totals
- ; Input:
- ; CNT - count of records printed
- ; TYP - indicator of which total count is being printed
- ; Output: Write lines of Sub-Totals and Totals per Flag and Category
- ;
- N DGTYPE,DGCOUNT
- S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II"))
- S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT))
- W:TYP=1 !
- W !,"Total Assignments for "_DGTYPE_": ",DGCOUNT
- Q
- ;
- HEAD ;Print/Display page header
- I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
- D PAUSE(.DGQ)
- Q:DGQ
- W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
- S DGPAGE=$G(DGPAGE)+1
- W !?25,"PATIENT RECORD FLAGS"
- W !?24,"FLAG ASSIGNMENT REPORT",?70,"Page: ",$G(DGPAGE)
- W !?24,"----------------------",?48,"Printed: ",DGDT
- W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
- W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
- W !?1,"FLAG NAME: ",$G(DGFG),!
- I DGGRAND W DGLINE Q
- ;IHS/OIT/LJF 12/22/2006 PATCH 1007 changed SSN to CHART #
- ;W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
- W !,"PATIENT NAME",?22,"CHART #",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
- W !,"--------------------",?22,"---------",?33,"--------",?43,"--------",?53,"--------",?63,"-----------------"
- Q
- ;
- EXIT ;
- I $D(ZTQUEUED) S ZTREQ="@"
- K @DGLIST
- I '$D(ZTQUEUED) D
- . K %ZIS,POP
- . D ^%ZISC,HOME^%ZIS
- Q
- DGPFRFA1 ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT CONT. ; 1/21/04 5:14pm
- +1 ;;5.3;Registration;**425,554,1007,1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 ;This routine will compile and produce the FLAG ASSIGNMENT REPORT.
- +4 ;This routine will be used to display or print all of the patient
- +5 ; assignments for Category I and Category II Patient Record Flags.
- +6 ;
- +7 ;All sort input was created in routine DGPFRFA.
- +8 ; Input: The following array contains the sort var's:
- +9 ; DGSORT("DGCAT") = category reporting on (I, II, or (B)oth)
- +10 ; DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on
- +11 ; = IEN of a (S)ingle Flag (#26.11)/(#26.15)
- +12 ; example: "1;DGPF(26.15,"
- +13 ; DGSORT("DGBEG") = Beginning date to report on
- +14 ; DGSORT("DGEND") = Ending date to report on
- +15 ;
- +16 ; Output: A formatted report of Record Flag Assignments to patients.
- +17 ;
- +18 ;- no direct entry
- +19 QUIT
- +20 ;
- START ; compile and print report
- +1 IF $EXTRACT(IOST)="C"
- DO WAIT^DICD
- +2 NEW DGLIST
- +3 SET DGLIST=$NAME(^TMP("DGPFRFA1",$JOB))
- +4 KILL @DGLIST
- +5 DO LOOP(.DGSORT)
- +6 DO PRINT(.DGSORT,DGLIST)
- +7 DO EXIT
- +8 QUIT
- +9 ;
- LOOP(DGSORT) ;use sort var's for record searching to build list
- +1 ; Input:
- +2 ; DGSORT - array of user selected report parameters
- +3 ;
- +4 ; Output:
- +5 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
- +6 ;
- +7 NEW DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGDFNLST
- +8 NEW DGC,DGF,DGX,DGQ,DGFG,DGSUB,DGCNT
- +9 SET (DGQ,DGFG,DGSUB,DGCNT)=0
- +10 SET DGX=""
- FOR
- SET DGX=$ORDER(DGSORT(DGX))
- IF DGX=""
- QUIT
- SET @DGX=DGSORT(DGX)
- +11 ;0 = both categories (National & Local)
- SET DGC=$SELECT(+DGCAT=3:0,1:+DGCAT)
- +12 IF DGC
- SET DGC=$SELECT(DGC=1:26.15,1:26.11)
- +13 ;"A"=all flags - "5;DGPF(26.11," is selection
- SET DGF=$PIECE(DGFLAG,U)
- +14 ; re-seed var to start looping before actual selection
- +15 IF +DGF
- Begin DoDot:1
- +16 ;previous value or NULL
- SET DGSUB=$ORDER(^DGPF(26.13,"AFLAG",DGF),-1)
- End DoDot:1
- +17 ; ex. DGSUB="5;DGPF(26.11," to loop ^DGPF(26.13,"AFLAG",DGSUB,dfn,ien
- +18 ;
- +19 SET (DGDFN,DGIEN)=""
- +20 FOR
- SET DGSUB=$ORDER(^DGPF(26.13,"AFLAG",DGSUB))
- IF DGSUB=""
- QUIT
- Begin DoDot:1
- +21 ;not correct file based on category
- IF DGC
- IF DGSUB'[DGC
- QUIT
- +22 ;don't setup or quit loop
- IF +DGF
- IF DGSUB'[DGF
- IF DGSUB>DGF
- SET DGQ=1
- QUIT
- +23 KILL DGDFNLST
- +24 ;get list of dfn's
- SET DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST)
- +25 IF 'DGCNT
- QUIT
- +26 FOR
- SET DGDFN=$ORDER(DGDFNLST(DGDFN))
- IF DGDFN=""
- QUIT
- Begin DoDot:2
- +27 SET DGIEN=$GET(DGDFNLST(DGDFN))
- IF DGIEN=""
- QUIT
- +28 DO BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
- End DoDot:2
- End DoDot:1
- IF DGQ
- QUIT
- +29 KILL DGDFNLST
- +30 QUIT
- +31 ;
- BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
- +1 ; Input:
- +2 ; DGSORT - array of user selected report parameters
- +3 ; DGDFN - ien of patient in PATIENT (#2) file
- +4 ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
- +5 ; DGLIST - temp global name used for report list
- +6 ;
- +7 ; Output:
- +8 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
- +9 ;
- +10 NEW DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGFG
- +11 SET (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV)=""
- +12 KILL DGPFA,DGPFAH,DGPFPAT
- +13 ;retrieve a single assign record
- +14 IF '$$GETASGN^DGPFAA(DGIEN,.DGPFA)
- QUIT
- +15 ;retrieve initial history assign record
- +16 IF '$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
- QUIT
- +17 ;-- get 'initial assignment' date
- +18 SET DGPFAH("INITASSIGN")=$GET(DGPFAH("ASSIGNDT"))
- +19 IF 'DGPFAH("INITASSIGN")
- QUIT
- +20 SET DGINIT=+DGPFAH("INITASSIGN")
- +21 IF DGINIT>DGBEG&($PIECE(DGINIT,".")'>DGEND)
- Begin DoDot:1
- +22 IF '$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
- QUIT
- +23 SET DGCATG=$SELECT(DGSUB[26.15:1,1:2)
- +24 SET DGFG=$PIECE(DGPFA("FLAG"),U,2)
- +25 SET DGNAME=DGPFPAT("NAME")
- +26 SET DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
- +27 IF +DGPFA("REVIEWDT")
- Begin DoDot:2
- +28 SET DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
- End DoDot:2
- +29 IF '$TEST
- SET DGREV="N/A"
- +30 SET DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_$PIECE(DGPFA("STATUS"),U,2)
- +31 SET DGLINE=DGLINE_U_$PIECE(DGPFA("OWNER"),U,2)
- +32 SET @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
- End DoDot:1
- +33 KILL DGPFA,DGPFAH,DGPFPAT
- +34 QUIT
- +35 ;
- PRINT(DGSORT,DGLIST) ;output report
- +1 ; Input:
- +2 ; DGSORT - array of user selected report parameters
- +3 ; DGLIST - temp global name used for report list
- +4 ;
- +5 ; Output: Formated report to user selected device
- +6 ;
- +7 NEW DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,X,Y,DGPAGE,DGDT,DGCNT,DGOFG,DGGRAND,DGLINE
- +8 SET (DGCNT,DGQ,DGPAGE,DGGRAND)=0
- SET $PIECE(DGLINE,"-",80)=""
- +9 SET DGDT=$PIECE($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
- +10 IF $ORDER(@DGLIST@(""))=""
- Begin DoDot:1
- +11 SET DGCAT=+DGSORT("DGCAT")
- +12 SET DGFG=$SELECT(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$PIECE(DGSORT("DGFLAG"),U,2))
- +13 DO HEAD
- +14 WRITE !!," >>> No Record Flag Assignments were found using the report criteria."
- End DoDot:1
- QUIT
- +15 ; loop and print report
- +16 SET (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
- +17 FOR
- SET DGCAT=$ORDER(@DGLIST@(DGCAT))
- IF DGCAT=""
- QUIT
- Begin DoDot:1
- +18 FOR
- SET DGFG=$ORDER(@DGLIST@(DGCAT,DGFG))
- IF DGFG=""
- QUIT
- Begin DoDot:2
- +19 IF DGFG'=DGOFG
- Begin DoDot:3
- +20 IF DGCNT
- DO SUB(.DGCNT,1)
- +21 DO HEAD
- +22 SET DGOFG=DGFG
- SET DGCNT=0
- End DoDot:3
- +23 FOR
- SET DGNAM=$ORDER(@DGLIST@(DGCAT,DGFG,DGNAM))
- IF DGNAM=""
- QUIT
- Begin DoDot:3
- +24 FOR
- SET DGDFN=$ORDER(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
- IF DGDFN=""
- QUIT
- Begin DoDot:4
- +25 SET DGCNT=DGCNT+1
- SET DGCNT(DGCAT)=$GET(DGCNT(DGCAT))+1
- +26 IF $Y>(IOSL-4)
- DO HEAD
- +27 IF DGQ
- QUIT
- +28 SET DGSTR=$GET(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
- +29 WRITE !,$EXTRACT(DGNAM,1,20),?22,$PIECE(DGSTR,U),?33,$PIECE(DGSTR,U,2),?43,$PIECE(DGSTR,U,3),?53,$PIECE(DGSTR,U,4),?63,$EXTRACT($PIECE(DGSTR,U,5),1,17)
- End DoDot:4
- IF DGQ
- QUIT
- End DoDot:3
- IF DGQ
- QUIT
- End DoDot:2
- IF DGQ
- QUIT
- +30 IF DGQ
- QUIT
- +31 IF DGCNT
- Begin DoDot:2
- +32 DO SUB(.DGCNT,1)
- +33 ;only if (A)ll flags
- IF DGSORT("DGFLAG")="A"
- DO SUB(.DGCNT,2)
- +34 SET DGOFG=""
- SET DGCNT=0
- End DoDot:2
- End DoDot:1
- IF DGQ
- QUIT
- +35 ;
- +36 ;Shutdown if stop task requested
- +37 IF DGQ
- IF $DATA(ZTQUEUED)
- WRITE !!,"REPORT STOPPED AT USER REQUEST"
- QUIT
- +38 ;
- +39 ; Grand totals (B)oth Categories
- IF +DGSORT("DGCAT")=3
- Begin DoDot:1
- +40 SET DGCAT=3
- SET DGFG="All Flags"
- SET DGGRAND=1
- +41 DO HEAD
- +42 WRITE !!,"REPORT SUMMARY:",!,"---------------"
- +43 FOR DGCAT=1,2,3
- Begin DoDot:2
- +44 IF DGCAT'=3
- SET DGCNT(3)=$GET(DGCNT(3))+$GET(DGCNT(DGCAT))
- +45 IF DGCAT=3
- WRITE !?39,"-------"
- +46 WRITE !,"Total Assignments for Category "
- +47 WRITE $SELECT(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
- +48 WRITE ?40,$JUSTIFY(+$GET(DGCNT(DGCAT)),6)
- End DoDot:2
- End DoDot:1
- +49 ;
- +50 WRITE !!,"<End of Report>"
- +51 QUIT
- +52 ;
- PAUSE(DGQ) ; pause screen display
- +1 ; Input:
- +2 ; DGQ - var used to quit report processing to user CRT
- +3 ; Output:
- +4 ; DGQ - passed by reference - 0 = Continue, 1 = Quit
- +5 ;
- +6 IF $GET(DGPAGE)>0
- IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF +Y=0
- SET DGQ=1
- +7 QUIT
- +8 ;
- SUB(CNT,TYP) ; print sub-totals
- +1 ; Input:
- +2 ; CNT - count of records printed
- +3 ; TYP - indicator of which total count is being printed
- +4 ; Output: Write lines of Sub-Totals and Totals per Flag and Category
- +5 ;
- +6 NEW DGTYPE,DGCOUNT
- +7 SET DGTYPE=$SELECT(TYP=1:"Flag",2:"Category "_$SELECT(DGCAT=1:"I",1:"II"))
- +8 SET DGCOUNT=$SELECT(TYP=1:CNT,1:DGCNT(DGCAT))
- +9 IF TYP=1
- WRITE !
- +10 WRITE !,"Total Assignments for "_DGTYPE_": ",DGCOUNT
- +11 QUIT
- +12 ;
- HEAD ;Print/Display page header
- +1 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET (ZTSTOP,DGQ)=1
- QUIT
- +2 DO PAUSE(.DGQ)
- +3 IF DGQ
- QUIT
- +4 IF '($EXTRACT(IOST,1,2)'="C-"&'DGPAGE)
- WRITE @IOF
- +5 SET DGPAGE=$GET(DGPAGE)+1
- +6 WRITE !?25,"PATIENT RECORD FLAGS"
- +7 WRITE !?24,"FLAG ASSIGNMENT REPORT",?70,"Page: ",$GET(DGPAGE)
- +8 WRITE !?24,"----------------------",?48,"Printed: ",DGDT
- +9 WRITE !?2,"CATEGORY: "_$SELECT($GET(DGCAT)=1:"Category I (National)",$GET(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
- +10 WRITE !,"DATE RANGE: ",$$FDATE^VALM1($GET(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($GET(DGSORT("DGEND")))
- +11 WRITE !?1,"FLAG NAME: ",$GET(DGFG),!
- +12 IF DGGRAND
- WRITE DGLINE
- QUIT
- +13 ;IHS/OIT/LJF 12/22/2006 PATCH 1007 changed SSN to CHART #
- +14 ;W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
- +15 WRITE !,"PATIENT NAME",?22,"CHART #",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
- +16 WRITE !,"--------------------",?22,"---------",?33,"--------",?43,"--------",?53,"--------",?63,"-----------------"
- +17 QUIT
- +18 ;
- EXIT ;
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 KILL @DGLIST
- +3 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +4 KILL %ZIS,POP
- +5 DO ^%ZISC
- DO HOME^%ZIS
- End DoDot:1
- +6 QUIT