GMTSRFHX ;WAT;Driver for CAT 1 PRF STATUS Component ;07/18/13 13:17
;;2.7;Health Summary;**103**;Oct 20, 1995;Build 7
Q
;;ICR REFERENCE
;;$$GETINF^DGPFAPIH 4903
;;$$GETFLAG^DGPFAPIU 5491
;;$$GETACT^DGPFAPI 3860
;;^DGPF(26.15,"B" 5991
;
EN ; entry point
N GMTSARR,COUNT,GMTSHX,FLGNAME,FLGPTR,RESULT,CAT,INCR,STATUS,NATL,FOUND,ERRMSG
N FLAGS S FLAGS=0,COUNT="",CAT="NATIONAL",RESULT="",INCR=1,STATUS="ACTIVE",NATL=0,FOUND=0,FLGNAME=""
Q:+$G(DFN)'>0
S FLAGS=$$GETACT^DGPFAPI(DFN,"GMTSARR")
I +$G(FLAGS)>0 D
.F S COUNT=$O(GMTSARR(COUNT)) Q:COUNT="" D
..I GMTSARR(COUNT,"CATEGORY")["NATIONAL" S NATL=1 Q
D:+$G(NATL)>0 HEADER
I +$G(FLAGS)>0 D
.F S COUNT=$O(GMTSARR(COUNT)) Q:COUNT="" D
..I GMTSARR(COUNT,"CATEGORY")["NATIONAL" D
...S FLGPTR=$P(GMTSARR(COUNT,"FLAG"),U)
...S RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSHX")
...Q:+$G(RESULT)'>0 ;if no results, no need to print
...D PRNTACT(COUNT)
I +$G(NATL)=0 D NOACTIVE
;;
S RESULT="" ;reset RESULT for INACTIVE flag processing
F S FLGNAME=$O(^DGPF(26.15,"B",FLGNAME)) Q:$G(FLGNAME)="" D
.S INCR=INCR+1
.S FLGPTR=$$GETFLAG^DGPFAPIU(FLGNAME,"N")
.I $G(FLGPTR)["-1" S ERRMSG=$P(FLGPTR,";",2) D ERR Q
.S RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSARR")
.Q:+$G(RESULT)'>0 ;if no results, skip to next flag
.S STATUS=$$GETSTAT(FLGNAME,CAT) Q:STATUS="ACTIVE" ;only want INACTIVE for this print
.D:GMTSARR("CATEGORY")["NATIONAL" PRNTINAC S FOUND=FOUND+1 ;only print NATIONAL flag info
D:+$G(FOUND)'>0 NOINACTV ;if STATUS never changes, no Inactive flags found
Q
;
GETSTAT(NAME,CATEG) ;get status of PRF assignment
N GMTSAFLG,GMTSFCNT,INDEX,FLAGSTAT
S FLAGSTAT="INACTIVE"
S GMTSFCNT=$$GETACT^DGPFAPI(DFN,"GMTSAFLG")>0 I $G(GMTSFCNT)>0 D
.S INDEX=""
.F S INDEX=$O(GMTSAFLG(INDEX)) Q:INDEX="" D
..I GMTSAFLG(INDEX,"FLAG")[$G(NAME)&(GMTSAFLG(INDEX,"CATEGORY")[$G(CATEG)) S FLAGSTAT="ACTIVE"
Q FLAGSTAT
;
NOACTIVE ;no active flags header
D CKP^GMTSUP Q:$D(GMTSQIT)
W "No ACTIVE Category I Patient Record Flag assignment(s) found.",!
Q
;
NOINACTV ;no Inactive flags header
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"No INACTIVE Category I Patient Record Flag assignment(s) found.",!
Q
D CKP^GMTSUP Q:$D(GMTSQIT)
W "ACTIVE Category I Patient Record Flag assignment(s):",!
Q
;
PRNTACT(ENTRY) ;show assignment info and hx for Active flags
N COUNTER S COUNTER=""
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"FLAG NAME: "_$P(GMTSARR(ENTRY,"FLAG"),"^",2)
W !,?3,"Current Status: "_$$GETSTAT($P(GMTSARR(ENTRY,"FLAG"),"^",2),"NATIONAL")
W !,?3,"Date Assigned: "_$P(GMTSARR(ENTRY,"ASSIGNDT"),"^",2)
W !,?3,"Next Review Date: "_$P(GMTSARR(ENTRY,"REVIEWDT"),"^",2)
W !,?3,"Owner Site: "_$P(GMTSARR(ENTRY,"OWNER"),"^",2)
W !,?3,"Originating Site: "_$P(GMTSARR(ENTRY,"ORIGSITE"),"^",2)
W !,?3,"Assignment History:"
F S COUNTER=$O(GMTSHX("HIST",COUNTER)) Q:COUNTER="" D
.W !,?5,"Date: "_$P(GMTSHX("HIST",COUNTER,"DATETIME"),"^",2)
.W !,?5,"Action: "_$P(GMTSHX("HIST",COUNTER,"ACTION"),"^",2)
.W !,?5,"Approved By: "_$P(GMTSHX("HIST",COUNTER,"APPRVBY"),"^",2),!
W:COUNTER="" !
Q
;
PRNTINAC(ENTRY) ;show assignment info and hx for Inctive flags
N COUNTER S COUNTER=""
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"INACTIVE Category I Patient Record Flag assignment(s):",!
W !,?2,"FLAG NAME: "_$P(GMTSARR("FLAG"),"^",2)
W !,?3,"Current Status: "_$$GETSTAT($P(GMTSARR("FLAG"),"^",2),"NATIONAL")
W !,?3,"Date Assigned: "_$P(GMTSARR("ASSIGNDT"),"^",2)
W !,?3,"Next Review Date: "_$P(GMTSARR("REVIEWDT"),"^",2)
W !,?3,"Owner Site: "_$P(GMTSARR("OWNER"),"^",2)
W !,?3,"Originating Site: "_$P(GMTSARR("ORIGSITE"),"^",2)
W !,?3,"Assignment History:"
F S COUNTER=$O(GMTSARR("HIST",COUNTER)) Q:COUNTER="" D
.W !,?5,"Date: "_$P(GMTSARR("HIST",COUNTER,"DATETIME"),"^",2)
.W !,?5,"Action: "_$P(GMTSARR("HIST",COUNTER,"ACTION"),"^",2)
.W !,?5,"Approved By: "_$P(GMTSARR("HIST",COUNTER,"APPRVBY"),"^",2),!!
Q
ERR ;can't find flag
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"Category I PRF "_$G(FLGNAME)_", is "_$G(ERRMSG)_".",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRFHX 4127 printed Nov 22, 2024@17:10:11 Page 2
GMTSRFHX ;WAT;Driver for CAT 1 PRF STATUS Component ;07/18/13 13:17
+1 ;;2.7;Health Summary;**103**;Oct 20, 1995;Build 7
+2 QUIT
+3 ;;ICR REFERENCE
+4 ;;$$GETINF^DGPFAPIH 4903
+5 ;;$$GETFLAG^DGPFAPIU 5491
+6 ;;$$GETACT^DGPFAPI 3860
+7 ;;^DGPF(26.15,"B" 5991
+8 ;
EN ; entry point
+1 NEW GMTSARR,COUNT,GMTSHX,FLGNAME,FLGPTR,RESULT,CAT,INCR,STATUS,NATL,FOUND,ERRMSG
+2 NEW FLAGS
SET FLAGS=0
SET COUNT=""
SET CAT="NATIONAL"
SET RESULT=""
SET INCR=1
SET STATUS="ACTIVE"
SET NATL=0
SET FOUND=0
SET FLGNAME=""
+3 if +$GET(DFN)'>0
QUIT
+4 SET FLAGS=$$GETACT^DGPFAPI(DFN,"GMTSARR")
+5 IF +$GET(FLAGS)>0
Begin DoDot:1
+6 FOR
SET COUNT=$ORDER(GMTSARR(COUNT))
if COUNT=""
QUIT
Begin DoDot:2
+7 IF GMTSARR(COUNT,"CATEGORY")["NATIONAL"
SET NATL=1
QUIT
End DoDot:2
End DoDot:1
+8 if +$GET(NATL)>0
DO HEADER
+9 IF +$GET(FLAGS)>0
Begin DoDot:1
+10 FOR
SET COUNT=$ORDER(GMTSARR(COUNT))
if COUNT=""
QUIT
Begin DoDot:2
+11 IF GMTSARR(COUNT,"CATEGORY")["NATIONAL"
Begin DoDot:3
+12 SET FLGPTR=$PIECE(GMTSARR(COUNT,"FLAG"),U)
+13 SET RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSHX")
+14 ;if no results, no need to print
if +$GET(RESULT)'>0
QUIT
+15 DO PRNTACT(COUNT)
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF +$GET(NATL)=0
DO NOACTIVE
+17 ;;
+18 ;reset RESULT for INACTIVE flag processing
SET RESULT=""
+19 FOR
SET FLGNAME=$ORDER(^DGPF(26.15,"B",FLGNAME))
if $GET(FLGNAME)=""
QUIT
Begin DoDot:1
+20 SET INCR=INCR+1
+21 SET FLGPTR=$$GETFLAG^DGPFAPIU(FLGNAME,"N")
+22 IF $GET(FLGPTR)["-1"
SET ERRMSG=$PIECE(FLGPTR,";",2)
DO ERR
QUIT
+23 SET RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSARR")
+24 ;if no results, skip to next flag
if +$GET(RESULT)'>0
QUIT
+25 ;only want INACTIVE for this print
SET STATUS=$$GETSTAT(FLGNAME,CAT)
if STATUS="ACTIVE"
QUIT
+26 ;only print NATIONAL flag info
if GMTSARR("CATEGORY")["NATIONAL"
DO PRNTINAC
SET FOUND=FOUND+1
End DoDot:1
+27 ;if STATUS never changes, no Inactive flags found
if +$GET(FOUND)'>0
DO NOINACTV
+28 QUIT
+29 ;
GETSTAT(NAME,CATEG) ;get status of PRF assignment
+1 NEW GMTSAFLG,GMTSFCNT,INDEX,FLAGSTAT
+2 SET FLAGSTAT="INACTIVE"
+3 SET GMTSFCNT=$$GETACT^DGPFAPI(DFN,"GMTSAFLG")>0
IF $GET(GMTSFCNT)>0
Begin DoDot:1
+4 SET INDEX=""
+5 FOR
SET INDEX=$ORDER(GMTSAFLG(INDEX))
if INDEX=""
QUIT
Begin DoDot:2
+6 IF GMTSAFLG(INDEX,"FLAG")[$GET(NAME)&(GMTSAFLG(INDEX,"CATEGORY")[$GET(CATEG))
SET FLAGSTAT="ACTIVE"
End DoDot:2
End DoDot:1
+7 QUIT FLAGSTAT
+8 ;
NOACTIVE ;no active flags header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE "No ACTIVE Category I Patient Record Flag assignment(s) found.",!
+3 QUIT
+4 ;
NOINACTV ;no Inactive flags header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE !,"No INACTIVE Category I Patient Record Flag assignment(s) found.",!
+3 QUIT
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE "ACTIVE Category I Patient Record Flag assignment(s):",!
+3 QUIT
+4 ;
PRNTACT(ENTRY) ;show assignment info and hx for Active flags
+1 NEW COUNTER
SET COUNTER=""
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 WRITE !,?2,"FLAG NAME: "_$PIECE(GMTSARR(ENTRY,"FLAG"),"^",2)
+4 WRITE !,?3,"Current Status: "_$$GETSTAT($PIECE(GMTSARR(ENTRY,"FLAG"),"^",2),"NATIONAL")
+5 WRITE !,?3,"Date Assigned: "_$PIECE(GMTSARR(ENTRY,"ASSIGNDT"),"^",2)
+6 WRITE !,?3,"Next Review Date: "_$PIECE(GMTSARR(ENTRY,"REVIEWDT"),"^",2)
+7 WRITE !,?3,"Owner Site: "_$PIECE(GMTSARR(ENTRY,"OWNER"),"^",2)
+8 WRITE !,?3,"Originating Site: "_$PIECE(GMTSARR(ENTRY,"ORIGSITE"),"^",2)
+9 WRITE !,?3,"Assignment History:"
+10 FOR
SET COUNTER=$ORDER(GMTSHX("HIST",COUNTER))
if COUNTER=""
QUIT
Begin DoDot:1
+11 WRITE !,?5,"Date: "_$PIECE(GMTSHX("HIST",COUNTER,"DATETIME"),"^",2)
+12 WRITE !,?5,"Action: "_$PIECE(GMTSHX("HIST",COUNTER,"ACTION"),"^",2)
+13 WRITE !,?5,"Approved By: "_$PIECE(GMTSHX("HIST",COUNTER,"APPRVBY"),"^",2),!
End DoDot:1
+14 if COUNTER=""
WRITE !
+15 QUIT
+16 ;
PRNTINAC(ENTRY) ;show assignment info and hx for Inctive flags
+1 NEW COUNTER
SET COUNTER=""
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 WRITE !,"INACTIVE Category I Patient Record Flag assignment(s):",!
+4 WRITE !,?2,"FLAG NAME: "_$PIECE(GMTSARR("FLAG"),"^",2)
+5 WRITE !,?3,"Current Status: "_$$GETSTAT($PIECE(GMTSARR("FLAG"),"^",2),"NATIONAL")
+6 WRITE !,?3,"Date Assigned: "_$PIECE(GMTSARR("ASSIGNDT"),"^",2)
+7 WRITE !,?3,"Next Review Date: "_$PIECE(GMTSARR("REVIEWDT"),"^",2)
+8 WRITE !,?3,"Owner Site: "_$PIECE(GMTSARR("OWNER"),"^",2)
+9 WRITE !,?3,"Originating Site: "_$PIECE(GMTSARR("ORIGSITE"),"^",2)
+10 WRITE !,?3,"Assignment History:"
+11 FOR
SET COUNTER=$ORDER(GMTSARR("HIST",COUNTER))
if COUNTER=""
QUIT
Begin DoDot:1
+12 WRITE !,?5,"Date: "_$PIECE(GMTSARR("HIST",COUNTER,"DATETIME"),"^",2)
+13 WRITE !,?5,"Action: "_$PIECE(GMTSARR("HIST",COUNTER,"ACTION"),"^",2)
+14 WRITE !,?5,"Approved By: "_$PIECE(GMTSARR("HIST",COUNTER,"APPRVBY"),"^",2),!!
End DoDot:1
+15 QUIT
ERR ;can't find flag
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE !,"Category I PRF "_$GET(FLGNAME)_", is "_$GET(ERRMSG)_".",!
+3 QUIT
