- 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 Apr 23, 2025@18:12:41 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
