Routine: DGPFAPI

DGPFAPI ;ALB/RBS - PRF EXTERNAL API'S ; 7/26/06 9:22am

 ;;5.3;Registration;**425,554,699,650,1015**;Aug 13, 1993;Build 21

 Q  ;no direct entry

GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments

 ;The purpose of this API is to facilitate the retrieval of specific

 ;data that can be used for the displaying of or the reporting of

 ;only ACTIVE Patient Record Flag (PRF) Assignment information for

 ;a patient.

 ; Associated DBIA:  #3860 - DGPF PATIENT RECORD FLAG

 ;  Input:

 ;   DGDFN - IEN of patient in the PATIENT (#2) file

 ;   DGPRF - Closed Root array of return values

 ;           [Optional-default DGPFAPI]

 ;  Output:

 ;   Function result - "0"  = No Active record flags for the patient

 ;                   - "nn" = Total number of flags returned in array

 ;     DGPRF() - Array, passed by closed root reference

 ;             - Multiple subscripted array of Active flag information

 ;               If the function call is successful, this array will

 ;               contain each of the Active flag records.

 ;             - Subscript field value = internal value^external value

 ;               2 piece string caret(^) delimited

 ;   DGPFAPI() - Default array name if no name passed

 ;  Subscript   Field Name                Field #/File #

 ;  ---------   ----------                --------------

 ;  "APPRVBY"   APPROVED BY               (.05)/(#26.14)

 ;              (Note: The .5 (POSTMASTER) internal field value

 ;               triggers an output transform that converts the

 ;               external value of "POSTMASTER" to "CHIEF OF STAFF".

 ;  "ASSIGNDT"  DATE/TIME                 (.02)/(#26.14)

 ;  "REVIEWDT"  REVIEW DATE               (.06)/(#26.13)

 ;  "FLAG"      FLAG NAME                 (.02)/(#26.13)

 ;  "FLAGTYPE"  TYPE                      (.03)/(#26.11 or #26.15)

 ;  "CATEGORY"  National or Local Flag    (#26.15) or (#26.11)

 ;  "OWNER"     OWNER SITE                (.04)/(#26.13)

 ;  "ORIGSITE"  ORIGINATING SITE          (.05)/(#26.13)

 ;  "TIUTITLE"  TIU PN TITLE              (.07)/(#26.11) or (#26.15)

 ;  "TIULINK"   TIU PN LINK               (.06)/(#26.14)

 ;  "NARR"      ASSIGNMENT NARRATIVE      (1)/(#26.13)

 ;              (word-processing, multiple nodes)

 ;              The format is in a word-processing value that may

 ;              contain multiple nodes of text.  Each node of text

 ;              will be less than 80 characters in length.

 ;              The format is as follows:

 ;   TARGET_ROOT(nn,"NARR",line#,0)=text

 ;      where:

 ;          nn = a unique number for each Flag

 ;       line# = a unique number starting at 1 for each wp line

 ;               of narrative text

 ;           0 = standard subscript format for the nodes of a

 ;               FileMan Word Processing field

 N DGPFTCNT  ;return results, "0"=no flags, "nn"=number of flags

 N DGPFIENS  ;array of all active flag assignment IEN's

 N DGPFIEN   ;ien of record flag assignment in (#26.13) file

 N DGPFA     ;flag assignment array

 N DGPFAH    ;flag assignment history array

 N DGPFLAG   ;flag record array

 N DGPFLAH   ;last flag assignment history array

 N DGCAT     ;flag category

 Q:'$G(DGDFN) 0                            ;Quit, null parameter

 Q:'$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1) 0   ;Quit, no Active assign's

 S DGPRF=$G(DGPRF)

 I DGPRF']"" S DGPRF="DGPFAPI"             ;setup default array name

 K @DGPRF                                  ;Kill/initialize work array

 S (DGPFIEN,DGCAT)="",DGPFTCNT=0

 ; loop all returned Active Record Flag Assignment ien's

 F  S DGPFIEN=$O(DGPFIENS(DGPFIEN)) Q:DGPFIEN=""  D

 . K DGPFA,DGPFAH,DGPFLAG,DGPFLAH

. ;

 . ; retrieve single assignment record fields

 . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA)

. ;

 . ; no patient DFN match

 . I DGDFN'=$P(DGPFA("DFN"),U) Q

. ;

 . ; get initial assignment history

 . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH)

. ;

 . ; get last assignment history

 . Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGPFIEN),.DGPFLAH)

. ;

 . ; get record flag record

 . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFLAG)

. ;

 . S DGPFTCNT=DGPFTCNT+1

. ;

 . ; approved by user

 . S @DGPRF@(DGPFTCNT,"APPRVBY")=$G(DGPFLAH("APPRVBY"))

. ;

 . ; initial assignment date/time

 . S @DGPRF@(DGPFTCNT,"ASSIGNDT")=$G(DGPFAH("ASSIGNDT"))

. ;

 . ; next review due date

 . S @DGPRF@(DGPFTCNT,"REVIEWDT")=$G(DGPFA("REVIEWDT"))

. ;

 . ; record flag name

 . S @DGPRF@(DGPFTCNT,"FLAG")=$G(DGPFA("FLAG"))

. ;

 . ; record flag type

 . S @DGPRF@(DGPFTCNT,"FLAGTYPE")=$G(DGPFLAG("TYPE"))

. ;

 . ; category of flag - I (NATIONAL) or II (LOCAL)

 . S DGCAT=$S($G(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)")

 . S @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT

. ;

 . ; owner site

 . S @DGPRF@(DGPFTCNT,"OWNER")=$G(DGPFA("OWNER"))_"  "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U))

. ;

 . ; originating site

 . S @DGPRF@(DGPFTCNT,"ORIGSITE")=$G(DGPFA("ORIGSITE"))_"  "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U))

. ;

 . ; add TIU info when Owner Site is a local division

 . I $$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) D

 . . ;

 . . ; flag associated TIU PN Title

 . . S @DGPRF@(DGPFTCNT,"TIUTITLE")=$G(DGPFLAG("TIUTITLE"))

 . . ;

 . . ; assignment history TIU PN Link

 . . S @DGPRF@(DGPFTCNT,"TIULINK")=$G(DGPFLAH("TIULINK"))

. ;

 . ; narrative

 . I '$D(DGPFA("NARR",1,0)) D  Q  ;should never happen - but -

 . . S @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text"

. ;

 . M @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR")

 ; Re-Sort Active flags by category & alpha flag name

 I +$G(DGPFTCNT)>1 D

 . I $$SORT^DGPFUT2(DGPRF)  ;naked IF to just do resort

 Q DGPFTCNT

PRFQRY(DGDFN) ;query a treating facility for patient record flag assignments

 ;This function queries a given patient's treating facility to retrieve

 ;all patient record flag assignments for the patient.

 ;  Input:

 ;    DGDFN - pointer to patient in PATIENT (#2) file

 ;  Output:

 ;   Function value - 1 on success, 0 on failure

 N DGEVNT

 N DGRSLT

 S DGRSLT=0

 S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN)

 I DGEVNT D

. ;

 . ;must have INCOMPLETE status

 . Q:'$$ISINCOMP^DGPFHLL1(DGEVNT)

. ;

 . ;run query using mode defined in PRF HL7 QUERY STATUS (#3) field of

 . ;PRF PARAMETERS (#26.18) file.

 . S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,$$QRYON^DGPFPARM())

 Q DGRSLT

DISPPRF(DGDFN) ;display active patient record flag assignments

 ;This procedure performs a lookup for active patient record flag

 ;assignments for a given patient and formats the assignment data for

 ;roll-and-scroll display.

 ;  Input:

 ;    DGDFN - pointer to patient in PATIENT (#2) file

 ;  Output:

 ;    none

 Q:'$D(XQY0)

 Q:$P(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT"

 ;protect Kernel IO variables

 N IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON,IOIL

 N IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON

 ;protect ListMan variables

 N VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON

 N VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST

 N VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD

 ;protect Unwinder variables

 N ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX

 N XQORM,DQ

 ; protect original Listman VALM DATA global

 K ^TMP($J,"DGPFVALM DATA")

 M ^TMP($J,"DGPFVALM DATA")=^TMP("VALM DATA",$J)

 D DISPPRF^DGPFUT1(DGDFN)

 ; restore original Listman VALM DATA global

 M ^TMP("VALM DATA",$J)=^TMP($J,"DGPFVALM DATA")

 K ^TMP($J,"DGPFVALM DATA")

DGPFAPI   ;ALB/RBS - PRF EXTERNAL API'S ; 7/26/06 9:22am

 +1       ;;5.3;Registration;**425,554,699,650,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ;no direct entry

           QUIT

 +4       ;

GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments

 +1       ;The purpose of this API is to facilitate the retrieval of specific

 +2       ;data that can be used for the displaying of or the reporting of

 +3       ;only ACTIVE Patient Record Flag (PRF) Assignment information for

 +4       ;a patient.

 +5       ;

 +6       ; Associated DBIA:  #3860 - DGPF PATIENT RECORD FLAG

 +7       ;

 +8       ;  Input:

 +9       ;   DGDFN - IEN of patient in the PATIENT (#2) file

 +10      ;   DGPRF - Closed Root array of return values

 +11      ;           [Optional-default DGPFAPI]

 +12      ;

 +13      ;  Output:

 +14      ;   Function result - "0"  = No Active record flags for the patient

 +15      ;                   - "nn" = Total number of flags returned in array

 +16      ;     DGPRF() - Array, passed by closed root reference

 +17      ;             - Multiple subscripted array of Active flag information

 +18      ;               If the function call is successful, this array will

 +19      ;               contain each of the Active flag records.

 +20      ;             - Subscript field value = internal value^external value

 +21      ;               2 piece string caret(^) delimited

 +22      ;   DGPFAPI() - Default array name if no name passed

 +23      ;

 +24      ;  Subscript   Field Name                Field #/File #

 +25      ;  ---------   ----------                --------------

 +26      ;  "APPRVBY"   APPROVED BY               (.05)/(#26.14)

 +27      ;              (Note: The .5 (POSTMASTER) internal field value

 +28      ;               triggers an output transform that converts the

 +29      ;               external value of "POSTMASTER" to "CHIEF OF STAFF".

 +30      ;  "ASSIGNDT"  DATE/TIME                 (.02)/(#26.14)

 +31      ;  "REVIEWDT"  REVIEW DATE               (.06)/(#26.13)

 +32      ;  "FLAG"      FLAG NAME                 (.02)/(#26.13)

 +33      ;  "FLAGTYPE"  TYPE                      (.03)/(#26.11 or #26.15)

 +34      ;  "CATEGORY"  National or Local Flag    (#26.15) or (#26.11)

 +35      ;  "OWNER"     OWNER SITE                (.04)/(#26.13)

 +36      ;  "ORIGSITE"  ORIGINATING SITE          (.05)/(#26.13)

 +37      ;  "TIUTITLE"  TIU PN TITLE              (.07)/(#26.11) or (#26.15)

 +38      ;  "TIULINK"   TIU PN LINK               (.06)/(#26.14)

 +39      ;  "NARR"      ASSIGNMENT NARRATIVE      (1)/(#26.13)

 +40      ;              (word-processing, multiple nodes)

 +41      ;              The format is in a word-processing value that may

 +42      ;              contain multiple nodes of text.  Each node of text

 +43      ;              will be less than 80 characters in length.

 +44      ;              The format is as follows:

 +45      ;   TARGET_ROOT(nn,"NARR",line#,0)=text

 +46      ;      where:

 +47      ;          nn = a unique number for each Flag

 +48      ;       line# = a unique number starting at 1 for each wp line

 +49      ;               of narrative text

 +50      ;           0 = standard subscript format for the nodes of a

 +51      ;               FileMan Word Processing field

 +52      ;

 +53      ;return results, "0"=no flags, "nn"=number of flags

           NEW DGPFTCNT

 +54      ;array of all active flag assignment IEN's

           NEW DGPFIENS

 +55      ;ien of record flag assignment in (#26.13) file

           NEW DGPFIEN

 +56      ;flag assignment array

           NEW DGPFA

 +57      ;flag assignment history array

           NEW DGPFAH

 +58      ;flag record array

           NEW DGPFLAG

 +59      ;last flag assignment history array

           NEW DGPFLAH

 +60      ;flag category

           NEW DGCAT

 +61      ;

 +62      ;Quit, null parameter

           IF '$GET(DGDFN)

               QUIT 0

 +63      ;Quit, no Active assign's

           IF '$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1)

               QUIT 0

 +64      ;

 +65       SET DGPRF=$GET(DGPRF)

 +66      ;setup default array name

           IF DGPRF']""

               SET DGPRF="DGPFAPI"

 +67      ;

 +68      ;Kill/initialize work array

           KILL @DGPRF

 +69      ;

 +70       SET (DGPFIEN,DGCAT)=""

           SET DGPFTCNT=0

 +71      ;

 +72      ; loop all returned Active Record Flag Assignment ien's

 +73       FOR

               SET DGPFIEN=$ORDER(DGPFIENS(DGPFIEN))

               IF DGPFIEN=""

                   QUIT

               Begin DoDot:1

 +74               KILL DGPFA,DGPFAH,DGPFLAG,DGPFLAH

 +75      ;

 +76      ; retrieve single assignment record fields

 +77               IF '$$GETASGN^DGPFAA(DGPFIEN,.DGPFA)

                       QUIT

 +78      ;

 +79      ; no patient DFN match

 +80               IF DGDFN'=$PIECE(DGPFA("DFN"),U)

                       QUIT

 +81      ;

 +82      ; get initial assignment history

 +83               IF '$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH)

                       QUIT

 +84      ;

 +85      ; get last assignment history

 +86               IF '$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGPFIEN),.DGPFLAH)

                       QUIT

 +87      ;

 +88      ; get record flag record

 +89               IF '$$GETFLAG^DGPFUT1($PIECE($GET(DGPFA("FLAG")),U),.DGPFLAG)

                       QUIT

 +90      ;

 +91               SET DGPFTCNT=DGPFTCNT+1

 +92      ;

 +93      ; approved by user

 +94               SET @DGPRF@(DGPFTCNT,"APPRVBY")=$GET(DGPFLAH("APPRVBY"))

 +95      ;

 +96      ; initial assignment date/time

 +97               SET @DGPRF@(DGPFTCNT,"ASSIGNDT")=$GET(DGPFAH("ASSIGNDT"))

 +98      ;

 +99      ; next review due date

 +100              SET @DGPRF@(DGPFTCNT,"REVIEWDT")=$GET(DGPFA("REVIEWDT"))

 +101     ;

 +102     ; record flag name

 +103              SET @DGPRF@(DGPFTCNT,"FLAG")=$GET(DGPFA("FLAG"))

 +104     ;

 +105     ; record flag type

 +106              SET @DGPRF@(DGPFTCNT,"FLAGTYPE")=$GET(DGPFLAG("TYPE"))

 +107     ;

 +108     ; category of flag - I (NATIONAL) or II (LOCAL)

 +109              SET DGCAT=$SELECT($GET(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)")

 +110              SET @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT

 +111     ;

 +112     ; owner site

 +113              SET @DGPRF@(DGPFTCNT,"OWNER")=$GET(DGPFA("OWNER"))_"  "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("OWNER")),U))

 +114     ;

 +115     ; originating site

 +116              SET @DGPRF@(DGPFTCNT,"ORIGSITE")=$GET(DGPFA("ORIGSITE"))_"  "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("ORIGSITE")),U))

 +117     ;

 +118     ; add TIU info when Owner Site is a local division

 +119              IF $$ISDIV^DGPFUT($PIECE(DGPFA("OWNER"),U))

                       Begin DoDot:2

 +120     ;

 +121     ; flag associated TIU PN Title

 +122                      SET @DGPRF@(DGPFTCNT,"TIUTITLE")=$GET(DGPFLAG("TIUTITLE"))

 +123     ;

 +124     ; assignment history TIU PN Link

 +125                      SET @DGPRF@(DGPFTCNT,"TIULINK")=$GET(DGPFLAH("TIULINK"))

                       End DoDot:2

 +126     ;

 +127     ; narrative

 +128     ;should never happen - but -

                   IF '$DATA(DGPFA("NARR",1,0))

                       Begin DoDot:2

 +129                      SET @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text"

                       End DoDot:2

                       QUIT

 +130     ;

 +131              MERGE @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR")

               End DoDot:1

 +132     ;

 +133     ; Re-Sort Active flags by category & alpha flag name

 +134      IF +$GET(DGPFTCNT)>1

               Begin DoDot:1

 +135     ;naked IF to just do resort

                   IF $$SORT^DGPFUT2(DGPRF)

               End DoDot:1

 +136     ;

 +137      QUIT DGPFTCNT

 +138     ;

PRFQRY(DGDFN) ;query a treating facility for patient record flag assignments

 +1       ;This function queries a given patient's treating facility to retrieve

 +2       ;all patient record flag assignments for the patient.

 +3       ;

 +4       ;  Input:

 +5       ;    DGDFN - pointer to patient in PATIENT (#2) file

 +6       ;

 +7       ;  Output:

 +8       ;   Function value - 1 on success, 0 on failure

 +9       ;

 +10       NEW DGEVNT

 +11       NEW DGRSLT

 +12      ;

 +13       SET DGRSLT=0

 +14       SET DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN)

 +15       IF DGEVNT

               Begin DoDot:1

 +16      ;

 +17      ;must have INCOMPLETE status

 +18               IF '$$ISINCOMP^DGPFHLL1(DGEVNT)

                       QUIT

 +19      ;

 +20      ;run query using mode defined in PRF HL7 QUERY STATUS (#3) field of

 +21      ;PRF PARAMETERS (#26.18) file.

 +22               SET DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,$$QRYON^DGPFPARM())

               End DoDot:1

 +23      ;

 +24       QUIT DGRSLT

 +25      ;

DISPPRF(DGDFN) ;display active patient record flag assignments

 +1       ;This procedure performs a lookup for active patient record flag

 +2       ;assignments for a given patient and formats the assignment data for

 +3       ;roll-and-scroll display.

 +4       ;

 +5       ;  Input:

 +6       ;    DGDFN - pointer to patient in PATIENT (#2) file

 +7       ;

 +8       ;  Output:

 +9       ;    none

 +10      ;

 +11       IF '$DATA(XQY0)

               QUIT

 +12       IF $PIECE(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT"

               QUIT

 +13      ;

 +14      ;protect Kernel IO variables

 +15       NEW IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON,IOIL

 +16       NEW IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON

 +17      ;

 +18      ;protect ListMan variables

 +19       NEW VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON

 +20       NEW VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST

 +21       NEW VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD

 +22      ;

 +23      ;protect Unwinder variables

 +24       NEW ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX

 +25       NEW XQORM,DQ

 +26      ;

 +27      ; protect original Listman VALM DATA global

 +28       KILL ^TMP($JOB,"DGPFVALM DATA")

 +29       MERGE ^TMP($JOB,"DGPFVALM DATA")=^TMP("VALM DATA",$JOB)

 +30      ;

 +31       DO DISPPRF^DGPFUT1(DGDFN)

 +32      ;

 +33      ; restore original Listman VALM DATA global

 +34       MERGE ^TMP("VALM DATA",$JOB)=^TMP($JOB,"DGPFVALM DATA")

 +35      ;

 +36       KILL ^TMP($JOB,"DGPFVALM DATA")

 +37       QUIT

DGPFAPI.m