GMTSMHRF.m

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