- DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm
- ;;5.3;Registration;**554,650,1015**;Aug 13, 1993;Build 21
- ;
- ;This routine will be used to display or print all of the patient
- ;assignment history records that are not linked to a progress note.
- ;
- ; Input: The following sort array contains the report parameters:
- ; DGSORT("DGCAT") = Flag Category to report on
- ; = 1:National, 2:Local, 3:Both
- ; DGSORT("DGBEG") = Beginning date to report on
- ; DGSORT("DGEND") = Ending date to report on
- ;
- ; Output: A formatted report of patient Assignment History Actions
- ; that are not linked to a TIU Progress Note.
- ;
- ;- no direct entry
- QUIT
- ;
- START ; compile and print report
- I $E(IOST)="C" D WAIT^DICD
- N DGLIST ;temp global name used for report list
- S DGLIST=$NA(^TMP("DGPFRAL1",$J))
- K @DGLIST
- D LOOP(.DGSORT,DGLIST)
- D PRINT(.DGSORT,DGLIST)
- K @DGLIST
- D EXIT
- Q
- ;
- LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
- ; Input:
- ; DGSORT - array of user selected report parameters
- ; DGLIST - temp global name
- ;
- ; Output:
- ; ^TMP("DGPFRAL1",$J) - temp global containing report output
- ;
- N DGBEG ;beginning date
- N DGC ;var used to check which category is being reported on
- N DGCAT ;flag category
- N DGCATG ;category 1 or 2
- N DGCNT ;flag counter
- N DGDFN ;pointer to patient being reported on
- N DGDFNLST ;array of dfn's assigned to the flag
- N DGEND ;ending date
- N DGHIENS ;array subscripted by assignment history date
- N DGIEN ;assignment ien
- N DGPAT ;patient data array
- N DGPFA ;assignment data array
- N DGQ ;quit var
- N DGSUB ;loop flag
- N DGX ;loop var
- ;
- ; setup variables equal to user input parameter subscripts
- ; "DGCAT", "DGBEG", "DGEND"
- S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
- S DGC=$S(+DGCAT=3:0,1:+DGCAT)
- S:DGC DGC=$S(DGC=1:26.15,1:26.11)
- ;
- ; loop assignment variable pointer flag x-ref file to run report
- S (DGDFN,DGIEN)="",(DGQ,DGSUB,DGCNT)=0
- 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
- . S DGCATG=$S(DGSUB[26.15:1,1:2)
- . K DGDFNLST
- . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST)
- . Q:'DGCNT
- . S DGDFN=""
- . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
- . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""
- . . ; get assignment record
- . . K DGPFA
- . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
- . . ; check if calling site is owner site
- . . Q:'$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U))
- . . ;
- . . ;filter patient when last action is ENTERED IN ERROR
- . . Q:$$ENTINERR(DGIEN)
- . . ;
- . . ;action ien array subscripted by assignment history date
- . . K DGHIENS
- . . Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)
- . . ; check if any Action's fall within the Begin and End dates
- . . I $P($O(DGHIENS("")),".")'>DGEND&($P($O(DGHIENS(""),-1),".")'<DGBEG) D
- . . . ;delete any action that is not within Begin and End dates
- . . . S DGX=0 F S DGX=$O(DGHIENS(DGX)) Q:DGX="" D
- . . . . I $P(DGX,".")<DGBEG!($P(DGX,".")>DGEND) K DGHIENS(DGX)
- . . . Q:'$O(DGHIENS(""))
- . . . ;
- . . . ; get patient demographics
- . . . K DGPAT
- . . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
- . . . ;
- . . . ; call to build temp global
- . . . D BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST)
- ;
- Q
- ;
- BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder
- ; Input:
- ; DGPFA - array of assignment record data
- ; DGPAT - array of patient demographics
- ; DGHIENS - array of history action IEN's sorted by d/t
- ; DGCATG - category of flag 1=National, 2=Local
- ; DGLIST - temp global name used for report list
- ;
- ; Output:
- ; ^TMP("DGPFRFA1",$J) - temp global containing report output
- ;
- N DGACTDT ;initial entry date
- N DGFGNM ;flag name
- N DGHIEN ;assignment ien
- N DGLINE ;report detail line
- N DGLNCNT ;unique subscript counter
- N DGPDFN ;pointer to patient
- N DGPFAH ;assignment history record data
- N DGPNM ;patient name
- ;
- ; loop all assignment history ien's
- S DGHIEN="",DGLNCNT=0
- F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D
- . ; get assignment history record
- . K DGPFAH
- . Q:'$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH)
- . Q:+$G(DGPFAH("TIULINK")) ;progress note pointer is setup
- . Q:+$G(DGPFAH("ACTION"))=5 ;don't report on ENTERED IN ERROR action
- . S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
- . S DGPNM=DGPAT("NAME")
- . S:DGPNM']"" DGPNM="MISSING PATIENT NAME"
- . S DGPDFN=$P(DGPFA("DFN"),U)
- . S DGFGNM=$P(DGPFA("FLAG"),U,2)
- . S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
- . S DGLINE=DGPAT("SSN")_U_$E(DGFGNM,1,17)_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT
- . S DGLNCNT=DGLNCNT+1
- . S @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE
- ;
- Q
- ;
- PRINT(DGSORT,DGLIST) ;output report
- ; Input:
- ; DGSORT - array of user selected report parameters
- ; DGLIST - temp global name used for report list
- ;
- ; Output: Formatted report to user selected device
- ;
- N DGCAT ;flag category
- N DGCNT ;counter of detail lines
- N DGDFN ;ien of patient
- N DGDT ;date time report printed
- N DGFG ;flag name
- N DGGRAND ;flag to print grand totals
- N DGLINE ;string of hyphens (80) for report header format
- N DGLN ;loop var
- N DGNAM ;patient name
- N DGODFN ;print loop var flag
- N DGOFG ;print loop var flag
- N DGPCAT ;print form of category
- N DGPAGE ;page counter
- N DGQ ;quit flag
- N DGSTR ;string of detail line to display
- N X,Y
- ;
- S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",81)=""
- S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
- S (DGCAT,DGPCAT)=+DGSORT("DGCAT")
- ;
- I $O(@DGLIST@(""))="" D Q
- . D HEAD
- . W !!," >>> No Record Flag Assignments were found using the report criteria.",!
- ;
- ; loop and print report
- S (DGCAT,DGFG,DGNAM,DGDFN,DGODFN,DGOFG,DGLN,DGSTR)=""
- F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
- . D HEAD S DGCNT=0
- . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
- .. 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
- .... F S DGLN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ
- ..... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN))
- ..... W !
- ..... I $Y>(IOSL-4) D PAUSE(.DGQ) Q:DGQ D HEAD S DGODFN="" W !
- ..... ; - write name and ssn once
- ..... I DGODFN'=DGDFN S DGODFN=DGDFN,DGOFG=DGFG D
- ...... W $E(DGNAM,1,18),?20,$P(DGSTR,U),?32,$E($P(DGSTR,U,2),1,17)
- ..... ; - write new flag name
- ..... I DGOFG'=DGFG S DGOFG=DGFG W ?32,$E($P(DGSTR,U,2),1,17)
- ..... ; - write action detail
- ..... W ?51,$P(DGSTR,U,3),?69,$P(DGSTR,U,4)
- ..... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
- . Q:DGQ
- . I DGCNT D
- .. W !!,"Total Actions not Linked for Category "_$S(DGCAT=1:"I",1:"II")_": ",?46,$J(+$G(DGCNT(DGCAT)),6)
- .. S DGCNT=0,DGODFN=""
- .. D:DGPCAT=3 PAUSE(.DGQ)
- ;
- ;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,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 !?48,"-------"
- .. W !,"Total Actions not Linked for Category "
- .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
- .. W ?49,$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
- ;
- HEAD ;Print/Display page header
- ;
- I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
- ;
- W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
- ;
- S DGPAGE=$G(DGPAGE)+1
- W !?25,"PATIENT RECORD FLAGS"
- W !?8,"ASSIGNMENT ACTION NOT LINKED TO A PROGRESS NOTE REPORT",?68,"Page: ",$G(DGPAGE)
- W !,"Report Selected: "_$S($G(DGPCAT)=1:"Category I (National)",$G(DGPCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
- W !?5,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
- W ?50,"Printed: ",DGDT
- W !,DGLINE
- ;
- Q:DGGRAND
- ;
- W !!,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
- W !!,"PATIENT",?20,"SSN",?32,"FLAG NAME",?51,"ACTION",?69,"ACTION DATE"
- W !,"------------------",?20,"----------",?32,"-----------------",?51,"----------------",?69,"-----------"
- Q
- ;
- EXIT ;
- I $D(ZTQUEUED) S ZTREQ="@"
- I '$D(ZTQUEUED) D
- . K %ZIS,POP
- . D ^%ZISC,HOME^%ZIS
- Q
- ;
- ENTINERR(DGIEN) ;is last action ENTERED IN ERROR
- ; Input:
- ; DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
- ;
- ; Output:
- ; Function Value - Return 1 on success, 0 on failure
- ;
- N DGPFAH
- ;
- I $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH)
- Q +$G(DGPFAH("ACTION"))=5
- DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm
- +1 ;;5.3;Registration;**554,650,1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 ;This routine will be used to display or print all of the patient
- +4 ;assignment history records that are not linked to a progress note.
- +5 ;
- +6 ; Input: The following sort array contains the report parameters:
- +7 ; DGSORT("DGCAT") = Flag Category to report on
- +8 ; = 1:National, 2:Local, 3:Both
- +9 ; DGSORT("DGBEG") = Beginning date to report on
- +10 ; DGSORT("DGEND") = Ending date to report on
- +11 ;
- +12 ; Output: A formatted report of patient Assignment History Actions
- +13 ; that are not linked to a TIU Progress Note.
- +14 ;
- +15 ;- no direct entry
- +16 QUIT
- +17 ;
- START ; compile and print report
- +1 IF $EXTRACT(IOST)="C"
- DO WAIT^DICD
- +2 ;temp global name used for report list
- NEW DGLIST
- +3 SET DGLIST=$NAME(^TMP("DGPFRAL1",$JOB))
- +4 KILL @DGLIST
- +5 DO LOOP(.DGSORT,DGLIST)
- +6 DO PRINT(.DGSORT,DGLIST)
- +7 KILL @DGLIST
- +8 DO EXIT
- +9 QUIT
- +10 ;
- LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
- +1 ; Input:
- +2 ; DGSORT - array of user selected report parameters
- +3 ; DGLIST - temp global name
- +4 ;
- +5 ; Output:
- +6 ; ^TMP("DGPFRAL1",$J) - temp global containing report output
- +7 ;
- +8 ;beginning date
- NEW DGBEG
- +9 ;var used to check which category is being reported on
- NEW DGC
- +10 ;flag category
- NEW DGCAT
- +11 ;category 1 or 2
- NEW DGCATG
- +12 ;flag counter
- NEW DGCNT
- +13 ;pointer to patient being reported on
- NEW DGDFN
- +14 ;array of dfn's assigned to the flag
- NEW DGDFNLST
- +15 ;ending date
- NEW DGEND
- +16 ;array subscripted by assignment history date
- NEW DGHIENS
- +17 ;assignment ien
- NEW DGIEN
- +18 ;patient data array
- NEW DGPAT
- +19 ;assignment data array
- NEW DGPFA
- +20 ;quit var
- NEW DGQ
- +21 ;loop flag
- NEW DGSUB
- +22 ;loop var
- NEW DGX
- +23 ;
- +24 ; setup variables equal to user input parameter subscripts
- +25 ; "DGCAT", "DGBEG", "DGEND"
- +26 SET DGX=""
- FOR
- SET DGX=$ORDER(DGSORT(DGX))
- IF DGX=""
- QUIT
- SET @DGX=DGSORT(DGX)
- +27 SET DGC=$SELECT(+DGCAT=3:0,1:+DGCAT)
- +28 IF DGC
- SET DGC=$SELECT(DGC=1:26.15,1:26.11)
- +29 ;
- +30 ; loop assignment variable pointer flag x-ref file to run report
- +31 SET (DGDFN,DGIEN)=""
- SET (DGQ,DGSUB,DGCNT)=0
- +32 FOR
- SET DGSUB=$ORDER(^DGPF(26.13,"AFLAG",DGSUB))
- IF DGSUB=""
- QUIT
- Begin DoDot:1
- +33 ;not correct file based on category
- IF DGC
- IF DGSUB'[DGC
- QUIT
- +34 SET DGCATG=$SELECT(DGSUB[26.15:1,1:2)
- +35 KILL DGDFNLST
- +36 SET DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST)
- +37 IF 'DGCNT
- QUIT
- +38 SET DGDFN=""
- +39 FOR
- SET DGDFN=$ORDER(DGDFNLST(DGDFN))
- IF DGDFN=""
- QUIT
- Begin DoDot:2
- +40 SET DGIEN=$GET(DGDFNLST(DGDFN))
- IF DGIEN=""
- QUIT
- +41 ; get assignment record
- +42 KILL DGPFA
- +43 IF '$$GETASGN^DGPFAA(DGIEN,.DGPFA)
- QUIT
- +44 ; check if calling site is owner site
- +45 IF '$$ISDIV^DGPFUT($PIECE(DGPFA("OWNER"),U))
- QUIT
- +46 ;
- +47 ;filter patient when last action is ENTERED IN ERROR
- +48 IF $$ENTINERR(DGIEN)
- QUIT
- +49 ;
- +50 ;action ien array subscripted by assignment history date
- +51 KILL DGHIENS
- +52 IF '$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)
- QUIT
- +53 ; check if any Action's fall within the Begin and End dates
- +54 IF $PIECE($ORDER(DGHIENS("")),".")'>DGEND&($PIECE($ORDER(DGHIENS(""),-1),".")'<DGBEG)
- Begin DoDot:3
- +55 ;delete any action that is not within Begin and End dates
- +56 SET DGX=0
- FOR
- SET DGX=$ORDER(DGHIENS(DGX))
- IF DGX=""
- QUIT
- Begin DoDot:4
- +57 IF $PIECE(DGX,".")<DGBEG!($PIECE(DGX,".")>DGEND)
- KILL DGHIENS(DGX)
- End DoDot:4
- +58 IF '$ORDER(DGHIENS(""))
- QUIT
- +59 ;
- +60 ; get patient demographics
- +61 KILL DGPAT
- +62 IF '$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
- QUIT
- +63 ;
- +64 ; call to build temp global
- +65 DO BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- IF DGQ
- QUIT
- +66 ;
- +67 QUIT
- +68 ;
- BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder
- +1 ; Input:
- +2 ; DGPFA - array of assignment record data
- +3 ; DGPAT - array of patient demographics
- +4 ; DGHIENS - array of history action IEN's sorted by d/t
- +5 ; DGCATG - category of flag 1=National, 2=Local
- +6 ; DGLIST - temp global name used for report list
- +7 ;
- +8 ; Output:
- +9 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
- +10 ;
- +11 ;initial entry date
- NEW DGACTDT
- +12 ;flag name
- NEW DGFGNM
- +13 ;assignment ien
- NEW DGHIEN
- +14 ;report detail line
- NEW DGLINE
- +15 ;unique subscript counter
- NEW DGLNCNT
- +16 ;pointer to patient
- NEW DGPDFN
- +17 ;assignment history record data
- NEW DGPFAH
- +18 ;patient name
- NEW DGPNM
- +19 ;
- +20 ; loop all assignment history ien's
- +21 SET DGHIEN=""
- SET DGLNCNT=0
- +22 FOR
- SET DGHIEN=$ORDER(DGHIENS(DGHIEN))
- IF DGHIEN=""
- QUIT
- Begin DoDot:1
- +23 ; get assignment history record
- +24 KILL DGPFAH
- +25 IF '$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH)
- QUIT
- +26 ;progress note pointer is setup
- IF +$GET(DGPFAH("TIULINK"))
- QUIT
- +27 ;don't report on ENTERED IN ERROR action
- IF +$GET(DGPFAH("ACTION"))=5
- QUIT
- +28 SET DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
- +29 SET DGPNM=DGPAT("NAME")
- +30 IF DGPNM']""
- SET DGPNM="MISSING PATIENT NAME"
- +31 SET DGPDFN=$PIECE(DGPFA("DFN"),U)
- +32 SET DGFGNM=$PIECE(DGPFA("FLAG"),U,2)
- +33 IF DGFGNM']""
- SET DGFGNM="MISSING FLAG NAME"
- +34 SET DGLINE=DGPAT("SSN")_U_$EXTRACT(DGFGNM,1,17)_U_$PIECE(DGPFAH("ACTION"),U,2)_U_DGACTDT
- +35 SET DGLNCNT=DGLNCNT+1
- +36 SET @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE
- End DoDot:1
- +37 ;
- +38 QUIT
- +39 ;
- 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: Formatted report to user selected device
- +6 ;
- +7 ;flag category
- NEW DGCAT
- +8 ;counter of detail lines
- NEW DGCNT
- +9 ;ien of patient
- NEW DGDFN
- +10 ;date time report printed
- NEW DGDT
- +11 ;flag name
- NEW DGFG
- +12 ;flag to print grand totals
- NEW DGGRAND
- +13 ;string of hyphens (80) for report header format
- NEW DGLINE
- +14 ;loop var
- NEW DGLN
- +15 ;patient name
- NEW DGNAM
- +16 ;print loop var flag
- NEW DGODFN
- +17 ;print loop var flag
- NEW DGOFG
- +18 ;print form of category
- NEW DGPCAT
- +19 ;page counter
- NEW DGPAGE
- +20 ;quit flag
- NEW DGQ
- +21 ;string of detail line to display
- NEW DGSTR
- +22 NEW X,Y
- +23 ;
- +24 SET (DGCNT,DGQ,DGPAGE,DGGRAND)=0
- SET $PIECE(DGLINE,"-",81)=""
- +25 SET DGDT=$PIECE($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
- +26 SET (DGCAT,DGPCAT)=+DGSORT("DGCAT")
- +27 ;
- +28 IF $ORDER(@DGLIST@(""))=""
- Begin DoDot:1
- +29 DO HEAD
- +30 WRITE !!," >>> No Record Flag Assignments were found using the report criteria.",!
- End DoDot:1
- QUIT
- +31 ;
- +32 ; loop and print report
- +33 SET (DGCAT,DGFG,DGNAM,DGDFN,DGODFN,DGOFG,DGLN,DGSTR)=""
- +34 FOR
- SET DGCAT=$ORDER(@DGLIST@(DGCAT))
- IF DGCAT=""
- QUIT
- Begin DoDot:1
- +35 DO HEAD
- SET DGCNT=0
- +36 FOR
- SET DGFG=$ORDER(@DGLIST@(DGCAT,DGFG))
- IF DGFG=""
- QUIT
- Begin DoDot:2
- +37 FOR
- SET DGNAM=$ORDER(@DGLIST@(DGCAT,DGFG,DGNAM))
- IF DGNAM=""
- QUIT
- Begin DoDot:3
- +38 FOR
- SET DGDFN=$ORDER(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
- IF DGDFN=""
- QUIT
- Begin DoDot:4
- +39 FOR
- SET DGLN=$ORDER(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN))
- IF DGLN=""
- QUIT
- Begin DoDot:5
- +40 SET DGSTR=$GET(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN))
- +41 WRITE !
- +42 IF $Y>(IOSL-4)
- DO PAUSE(.DGQ)
- IF DGQ
- QUIT
- DO HEAD
- SET DGODFN=""
- WRITE !
- +43 ; - write name and ssn once
- +44 IF DGODFN'=DGDFN
- SET DGODFN=DGDFN
- SET DGOFG=DGFG
- Begin DoDot:6
- +45 WRITE $EXTRACT(DGNAM,1,18),?20,$PIECE(DGSTR,U),?32,$EXTRACT($PIECE(DGSTR,U,2),1,17)
- End DoDot:6
- +46 ; - write new flag name
- +47 IF DGOFG'=DGFG
- SET DGOFG=DGFG
- WRITE ?32,$EXTRACT($PIECE(DGSTR,U,2),1,17)
- +48 ; - write action detail
- +49 WRITE ?51,$PIECE(DGSTR,U,3),?69,$PIECE(DGSTR,U,4)
- +50 SET DGCNT=DGCNT+1
- SET DGCNT(DGCAT)=$GET(DGCNT(DGCAT))+1
- End DoDot:5
- IF DGQ
- QUIT
- End DoDot:4
- IF DGQ
- QUIT
- End DoDot:3
- IF DGQ
- QUIT
- End DoDot:2
- IF DGQ
- QUIT
- +51 IF DGQ
- QUIT
- +52 IF DGCNT
- Begin DoDot:2
- +53 WRITE !!,"Total Actions not Linked for Category "_$SELECT(DGCAT=1:"I",1:"II")_": ",?46,$JUSTIFY(+$GET(DGCNT(DGCAT)),6)
- +54 SET DGCNT=0
- SET DGODFN=""
- +55 IF DGPCAT=3
- DO PAUSE(.DGQ)
- End DoDot:2
- End DoDot:1
- IF DGQ
- QUIT
- +56 ;
- +57 ;Shutdown if stop task requested
- +58 IF DGQ
- IF $DATA(ZTQUEUED)
- WRITE !!,"REPORT STOPPED AT USER REQUEST"
- QUIT
- +59 ;
- +60 ; Grand totals (B)oth Categories
- IF +DGSORT("DGCAT")=3
- Begin DoDot:1
- +61 SET DGCAT=3
- SET DGGRAND=1
- +62 DO HEAD
- +63 WRITE !!,"REPORT SUMMARY:",!,"---------------"
- +64 FOR DGCAT=1,2,3
- Begin DoDot:2
- +65 IF DGCAT'=3
- SET DGCNT(3)=$GET(DGCNT(3))+$GET(DGCNT(DGCAT))
- +66 IF DGCAT=3
- WRITE !?48,"-------"
- +67 WRITE !,"Total Actions not Linked for Category "
- +68 WRITE $SELECT(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
- +69 WRITE ?49,$JUSTIFY(+$GET(DGCNT(DGCAT)),6)
- End DoDot:2
- End DoDot:1
- +70 ;
- +71 WRITE !!,"<End of Report>"
- +72 QUIT
- +73 ;
- 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 ;
- HEAD ;Print/Display page header
- +1 ;
- +2 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET (ZTSTOP,DGQ)=1
- QUIT
- +3 ;
- +4 IF '($EXTRACT(IOST,1,2)'="C-"&'DGPAGE)
- WRITE @IOF
- +5 ;
- +6 SET DGPAGE=$GET(DGPAGE)+1
- +7 WRITE !?25,"PATIENT RECORD FLAGS"
- +8 WRITE !?8,"ASSIGNMENT ACTION NOT LINKED TO A PROGRESS NOTE REPORT",?68,"Page: ",$GET(DGPAGE)
- +9 WRITE !,"Report Selected: "_$SELECT($GET(DGPCAT)=1:"Category I (National)",$GET(DGPCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
- +10 WRITE !?5,"DATE RANGE: ",$$FDATE^VALM1($GET(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($GET(DGSORT("DGEND")))
- +11 WRITE ?50,"Printed: ",DGDT
- +12 WRITE !,DGLINE
- +13 ;
- +14 IF DGGRAND
- QUIT
- +15 ;
- +16 WRITE !!,"CATEGORY: "_$SELECT($GET(DGCAT)=1:"Category I (National)",$GET(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
- +17 WRITE !!,"PATIENT",?20,"SSN",?32,"FLAG NAME",?51,"ACTION",?69,"ACTION DATE"
- +18 WRITE !,"------------------",?20,"----------",?32,"-----------------",?51,"----------------",?69,"-----------"
- +19 QUIT
- +20 ;
- EXIT ;
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +3 KILL %ZIS,POP
- +4 DO ^%ZISC
- DO HOME^%ZIS
- End DoDot:1
- +5 QUIT
- +6 ;
- ENTINERR(DGIEN) ;is last action ENTERED IN ERROR
- +1 ; Input:
- +2 ; DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
- +3 ;
- +4 ; Output:
- +5 ; Function Value - Return 1 on success, 0 on failure
- +6 ;
- +7 NEW DGPFAH
- +8 ;
- +9 IF $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH)
- +10 QUIT +$GET(DGPFAH("ACTION"))=5