GMTSMHRF ;BP/WAT - DRIVER FOR PRF ASSIGNMENT HX ;09/05/12 13:47
;;2.7;Health Summary;**99,104**;Oct 20, 1995;Build 38
;
;EXTERNAL CALLS
;$$GETINF^DGPFAPIH 4903
;$$GETFLAG^DGPFAPIU 5491
;$$GETACT^DGPFAPI 3860
;$$GET^XPAR 2263
;
Q
;
EN ;start here
;FLGPTR - IEN;FILE - 1234;DGPF(26.11
;DGSTART - OPTIONAL; GETS ALL HX IF NOT DEFINED
;DGEND - SAME AS START DATE
;GMTSARR - OPTIONAL ROOT FOR RETURN; IF NOT SPEC'D DGPFAPI1 IS DEFAULT
;DGRSLT - RESULT OF CALL, 1 SUCCESS; 0 FAIL
;DGPF SUICIDE FLAG - parameter to call and discover what name a site uses for the PRF suicide flag.
N FLGNAME,FLGPTR,RESULT,GMTSARR,ERRMSG,CATEGORY,CAT,GMTSSTAT
S FLGNAME="HIGH RISK FOR SUICIDE"
S FLGPTR=$$GETFLAG^DGPFAPIU(FLGNAME,"N"),CAT="NATIONAL"
I $G(FLGPTR)["-1" S CATEGORY="I",ERRMSG=$P(FLGPTR,";",2) D ERR Q
S RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSARR")
I $G(RESULT) S GMTSSTAT=$$GETSTAT(FLGNAME,CAT) D PRINT S RESULT=0
S FLGNAME=$$GET^XPAR("PKG","DGPF SUICIDE FLAG",1,"E")
Q:$G(FLGNAME)=""
S FLGPTR=$$GETFLAG^DGPFAPIU(FLGNAME,"L"),CAT="LOCAL"
Q:$G(FLGPTR)["-1" ;not alerting of error b/c CatII flag will eventually be deactivated
S RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSARR")
I $G(RESULT) S GMTSSTAT=$$GETSTAT(FLGNAME,CAT) D PRINT
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
;
PRINT ;SHOW THE FLAG HX
N COUNT S COUNT=""
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?2,"CATEGORY "_$P(GMTSARR("CATEGORY"),"^")_" PRF: "_$P(GMTSARR("FLAG"),"^",2)
W !,?3,"Current Status: "_$G(GMTSSTAT)
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 COUNT=$O(GMTSARR("HIST",COUNT)) Q:COUNT="" D
.W !,?5,"Date: "_$P(GMTSARR("HIST",COUNT,"DATETIME"),"^",2)
.W !,?5,"Action: "_$P(GMTSARR("HIST",COUNT,"ACTION"),"^",2)
.W !,?5,"Approved By: "_$P(GMTSARR("HIST",COUNT,"APPRVBY"),"^",2),!!
Q
ERR ;can't find flag
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"Category "_CATEGORY_" PRF, "_FLGNAME_", is "_ERRMSG_".",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSMHRF 2489 printed Nov 22, 2024@17:08:20 Page 2
GMTSMHRF ;BP/WAT - DRIVER FOR PRF ASSIGNMENT HX ;09/05/12 13:47
+1 ;;2.7;Health Summary;**99,104**;Oct 20, 1995;Build 38
+2 ;
+3 ;EXTERNAL CALLS
+4 ;$$GETINF^DGPFAPIH 4903
+5 ;$$GETFLAG^DGPFAPIU 5491
+6 ;$$GETACT^DGPFAPI 3860
+7 ;$$GET^XPAR 2263
+8 ;
+9 QUIT
+10 ;
EN ;start here
+1 ;FLGPTR - IEN;FILE - 1234;DGPF(26.11
+2 ;DGSTART - OPTIONAL; GETS ALL HX IF NOT DEFINED
+3 ;DGEND - SAME AS START DATE
+4 ;GMTSARR - OPTIONAL ROOT FOR RETURN; IF NOT SPEC'D DGPFAPI1 IS DEFAULT
+5 ;DGRSLT - RESULT OF CALL, 1 SUCCESS; 0 FAIL
+6 ;DGPF SUICIDE FLAG - parameter to call and discover what name a site uses for the PRF suicide flag.
+7 NEW FLGNAME,FLGPTR,RESULT,GMTSARR,ERRMSG,CATEGORY,CAT,GMTSSTAT
+8 SET FLGNAME="HIGH RISK FOR SUICIDE"
+9 SET FLGPTR=$$GETFLAG^DGPFAPIU(FLGNAME,"N")
SET CAT="NATIONAL"
+10 IF $GET(FLGPTR)["-1"
SET CATEGORY="I"
SET ERRMSG=$PIECE(FLGPTR,";",2)
DO ERR
QUIT
+11 SET RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSARR")
+12 IF $GET(RESULT)
SET GMTSSTAT=$$GETSTAT(FLGNAME,CAT)
DO PRINT
SET RESULT=0
+13 SET FLGNAME=$$GET^XPAR("PKG","DGPF SUICIDE FLAG",1,"E")
+14 if $GET(FLGNAME)=""
QUIT
+15 SET FLGPTR=$$GETFLAG^DGPFAPIU(FLGNAME,"L")
SET CAT="LOCAL"
+16 ;not alerting of error b/c CatII flag will eventually be deactivated
if $GET(FLGPTR)["-1"
QUIT
+17 SET RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSARR")
+18 IF $GET(RESULT)
SET GMTSSTAT=$$GETSTAT(FLGNAME,CAT)
DO PRINT
+19 QUIT
+20 ;
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 ;
PRINT ;SHOW THE FLAG HX
+1 NEW COUNT
SET COUNT=""
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 WRITE ?2,"CATEGORY "_$PIECE(GMTSARR("CATEGORY"),"^")_" PRF: "_$PIECE(GMTSARR("FLAG"),"^",2)
+4 WRITE !,?3,"Current Status: "_$GET(GMTSSTAT)
+5 WRITE !,?3,"Date Assigned: "_$PIECE(GMTSARR("ASSIGNDT"),"^",2)
+6 WRITE !,?3,"Next Review Date: "_$PIECE(GMTSARR("REVIEWDT"),"^",2)
+7 WRITE !,?3,"Owner Site: "_$PIECE(GMTSARR("OWNER"),"^",2)
+8 WRITE !,?3,"Originating Site: "_$PIECE(GMTSARR("ORIGSITE"),"^",2)
+9 WRITE !,?3,"Assignment History:"
+10 FOR
SET COUNT=$ORDER(GMTSARR("HIST",COUNT))
if COUNT=""
QUIT
Begin DoDot:1
+11 WRITE !,?5,"Date: "_$PIECE(GMTSARR("HIST",COUNT,"DATETIME"),"^",2)
+12 WRITE !,?5,"Action: "_$PIECE(GMTSARR("HIST",COUNT,"ACTION"),"^",2)
+13 WRITE !,?5,"Approved By: "_$PIECE(GMTSARR("HIST",COUNT,"APPRVBY"),"^",2),!!
End DoDot:1
+14 QUIT
ERR ;can't find flag
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE !,"Category "_CATEGORY_" PRF, "_FLGNAME_", is "_ERRMSG_".",!
+3 QUIT
