DG53869P ;CHY/TJ - DG*5.3*869 MISSING - PRF POST ROUTINE ;
;;5.3;Registration;**869**;AUG 13,1993;Build 15
;
; Post Installation Routine for patch DG*5.3*869
;
EN ;
D MGSETUP ; <--- Creates MailGroup (DGPF MISSING PT FLAG REVIEW) File # (3.8)
D DGPFSET ; <--- Creates Patient Record Flag (MISSING PATIENT) File # (26.15)
Q
;
MGSETUP ;
;
;DBIA: 1146 $$MG^XMBGRP Supported
;
;This mail group API contains the entry point $$MG^XMBGRP
;Creates a mail group or add local members to an existing mail group.
;
;If the mail group does not exist, it will be created. Local
;members may be added. There is no way to add other kinds of
;members. XMTYPE, XMORG, XMSELF, and XMDESC are accepted.
;Usage: S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
;This function returns the mail group IEN if successful; 0 if not.
;
;Parameters:
;XMGROUP mail group IEN or name
;XMTYPE mail group type (public or private)
;XMORG organizer DUZ
;XMSELF self enrollment allowed?
;.XMY array of local members
;.XMDESC array of text for the mail group description
;XMQUIET silent flag
;
N XMGROUP,XMTYPE,XMORG,XMSELF,XMQUIET K XMY,XMDESC S (XMY,XMDESC)="" ;new parameters
S XMGROUP="DGPF MISSING PT FLAG REVIEW" ;mail group IEN or name
S XMTYPE=0 ;mail group type (public or private)
S XMORG=$G(XPDQUES("POS1 QUESTION"),DUZ) ;organizer (default=DUZ)
S XMSELF=1 ;self enrollment allowed?
S XMY="" ;array of local members
S XMDESC="Members of this Mail Group will be notified via a MailMan message when a patient/resident has been assigned the NATIONAL, CATAGORY I - MISSING PATIENT RECORD FLAG" ;array of text for the mail group description
S XMQUIET=0 ;silent flag
;
N X S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
D:+X>0 BMES^XPDUTL("Mail Group "_XMGROUP_" created")
Q
;
DGPFSET ;
;DG*5.3*869
;2.6.1. Create a new 'Missing Patient' national PRF entry in the PRF National Flag file #26.15.
;New National (Category I) PRF definition:
; Name: MISSING PATIENT
; Status: ACTIVE or INACTIVE*
; Type: CLINICAL
; Review Frequency Days: 30
; Notification Days: 7
; Review Mail Group: DGPF MISSING PT FLAG REVIEW
; TIU PN Title: PATIENT RECORD FLAG CATEGORY 1 - MISSING PATIENT
; Description:
; The purpose of this flag is to identify a missing
; patient in the electronic medical record, including
; a Text Integration Utility (TIU) progress note describing
; the risk and circumstances.
;
I $$PRODPRF()'["**ERROR**" D BMES^XPDUTL("National Category I , Patient Record Flag: MISSING PATIENT created")
Q
;
PRODPRF() ;
N DGPFERR,DGPFFDA,DGPFIEN,DGPFMSG,DGPFNM,DGPFSTAT,DGPFTYP,DGPFRFD,DGPFNOTD,DGPFRMG,DGPFTIU,DGPFDSC
S DGPFNM="MISSING PATIENT" ;<--- NAT FLAG NAME (MISSING PATIENT)
S DGPFSTAT=1 ;<--- ACTIVE STATUS (1)
S DGPFTYP=$$FIND1^DIC(26.16,"","X","CLINICAL","B") ;<--- TYPE (CLINICAL)
S DGPFRFD=30 ;<--- REVIEW FREQUENCY DAYS (30)
S DGPFNOTD=7 ;<--- NOTIFICATION DAYS (7)
S DGPFRMG=$$FIND1^DIC(3.8,"","X","DGPF MISSING PT FLAG REVIEW","B") ;<--- REVIEW MAIL GROUP (DGPF MISSING PT FLAG REVIEW)
I +DGPFRMG'>0 S DGPFERR=" **ERROR** UNABLE TO DEFINE * "_"DGPF MISSING PT FLAG REVIEW"_" * MAIL GROUP" D BMES^XPDUTL(DGPFERR) Q DGPFERR
S DGPFTIU=$$FIND1^DIC(8925.1,"","X","PATIENT RECORD FLAG CATEGORY I - MISSING PATIENT","B") ;<--- TIU PN TITLE (PATIENT RECORD FLAG CATEGORY 1 - MISSING PATIENT)
I +DGPFTIU'>0 S DGPFERR=" **ERROR** UNABLE TO DEFINE * ""PATIENT RECORD FLAG CATEGORY 1 - MISSING PATIENT"" * TIU PN TITLE" D BMES^XPDUTL(DGPFERR) Q DGPFERR
S DGPFDSC(1)="The purpose of this flag is to identify a missing patient in the "
S DGPFDSC(2)="electronic medical record, including a Text Integration Utility (TIU) "
S DGPFDSC(3)="progress note describing the risk and circumstances."
S DGPFERR=" PRF National Flag Created: "_DGPFNM
S DGPFFDA(26.15,"?+1,",.01)=DGPFNM ; NAME
S DGPFFDA(26.15,"?+1,",.02)=DGPFSTAT ; STATUS
S DGPFFDA(26.15,"?+1,",.03)=DGPFTYP ; TYPE
S DGPFFDA(26.15,"?+1,",.04)=DGPFRFD ; REVIEW FREQUENCY DAYS
S DGPFFDA(26.15,"?+1,",.05)=DGPFNOTD ; NOTIFICATION DAYS
S DGPFFDA(26.15,"?+1,",.06)=DGPFRMG ; REVIEW MAIL GROUP
S DGPFFDA(26.15,"?+1,",.07)=DGPFTIU ; TIU PN TITLE
D UPDATE^DIE("","DGPFFDA","DGPFIEN","DGPFMSG")
;D WP^DIE(file,iens,field,flags,wp_root,msg_root)
S:'$G(DGPFIEN) DGPFIEN=+DGPFIEN(1)
D WP^DIE(26.15,DGPFIEN_",",1,"","DGPFDSC","DGPFMSG") ; DESCRIPTION
I $D(DGPFMSG) D Q DGPFERR
. S DGPFERR=" **ERROR** "_$G(DGPFMSG("DIERR",1))_" Unable to create Patient Record Flag: "_DGPFNM
; Find the IEN of the NATIONAL PRF
S DGPFIEN=$$FIND1^DIC(26.15,"","X",DGPFNM,"B")
I 'DGPFIEN D Q DGPFERR
. S DGPFERR=" **ERROR** Unable to locate NAT PRF - "_DGPFNM
Q DGPFERR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53869P 4895 printed Dec 13, 2024@02:39:10 Page 2
DG53869P ;CHY/TJ - DG*5.3*869 MISSING - PRF POST ROUTINE ;
+1 ;;5.3;Registration;**869**;AUG 13,1993;Build 15
+2 ;
+3 ; Post Installation Routine for patch DG*5.3*869
+4 ;
EN ;
+1 ; <--- Creates MailGroup (DGPF MISSING PT FLAG REVIEW) File # (3.8)
DO MGSETUP
+2 ; <--- Creates Patient Record Flag (MISSING PATIENT) File # (26.15)
DO DGPFSET
+3 QUIT
+4 ;
MGSETUP ;
+1 ;
+2 ;DBIA: 1146 $$MG^XMBGRP Supported
+3 ;
+4 ;This mail group API contains the entry point $$MG^XMBGRP
+5 ;Creates a mail group or add local members to an existing mail group.
+6 ;
+7 ;If the mail group does not exist, it will be created. Local
+8 ;members may be added. There is no way to add other kinds of
+9 ;members. XMTYPE, XMORG, XMSELF, and XMDESC are accepted.
+10 ;Usage: S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
+11 ;This function returns the mail group IEN if successful; 0 if not.
+12 ;
+13 ;Parameters:
+14 ;XMGROUP mail group IEN or name
+15 ;XMTYPE mail group type (public or private)
+16 ;XMORG organizer DUZ
+17 ;XMSELF self enrollment allowed?
+18 ;.XMY array of local members
+19 ;.XMDESC array of text for the mail group description
+20 ;XMQUIET silent flag
+21 ;
+22 ;new parameters
NEW XMGROUP,XMTYPE,XMORG,XMSELF,XMQUIET
KILL XMY,XMDESC
SET (XMY,XMDESC)=""
+23 ;mail group IEN or name
SET XMGROUP="DGPF MISSING PT FLAG REVIEW"
+24 ;mail group type (public or private)
SET XMTYPE=0
+25 ;organizer (default=DUZ)
SET XMORG=$GET(XPDQUES("POS1 QUESTION"),DUZ)
+26 ;self enrollment allowed?
SET XMSELF=1
+27 ;array of local members
SET XMY=""
+28 ;array of text for the mail group description
SET XMDESC="Members of this Mail Group will be notified via a MailMan message when a patient/resident has been assigned the NATIONAL, CATAGORY I - MISSING PATIENT RECORD FLAG"
+29 ;silent flag
SET XMQUIET=0
+30 ;
+31 NEW X
SET X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
+32 if +X>0
DO BMES^XPDUTL("Mail Group "_XMGROUP_" created")
+33 QUIT
+34 ;
DGPFSET ;
+1 ;DG*5.3*869
+2 ;2.6.1. Create a new 'Missing Patient' national PRF entry in the PRF National Flag file #26.15.
+3 ;New National (Category I) PRF definition:
+4 ; Name: MISSING PATIENT
+5 ; Status: ACTIVE or INACTIVE*
+6 ; Type: CLINICAL
+7 ; Review Frequency Days: 30
+8 ; Notification Days: 7
+9 ; Review Mail Group: DGPF MISSING PT FLAG REVIEW
+10 ; TIU PN Title: PATIENT RECORD FLAG CATEGORY 1 - MISSING PATIENT
+11 ; Description:
+12 ; The purpose of this flag is to identify a missing
+13 ; patient in the electronic medical record, including
+14 ; a Text Integration Utility (TIU) progress note describing
+15 ; the risk and circumstances.
+16 ;
+17 IF $$PRODPRF()'["**ERROR**"
DO BMES^XPDUTL("National Category I , Patient Record Flag: MISSING PATIENT created")
+18 QUIT
+19 ;
PRODPRF() ;
+1 NEW DGPFERR,DGPFFDA,DGPFIEN,DGPFMSG,DGPFNM,DGPFSTAT,DGPFTYP,DGPFRFD,DGPFNOTD,DGPFRMG,DGPFTIU,DGPFDSC
+2 ;<--- NAT FLAG NAME (MISSING PATIENT)
SET DGPFNM="MISSING PATIENT"
+3 ;<--- ACTIVE STATUS (1)
SET DGPFSTAT=1
+4 ;<--- TYPE (CLINICAL)
SET DGPFTYP=$$FIND1^DIC(26.16,"","X","CLINICAL","B")
+5 ;<--- REVIEW FREQUENCY DAYS (30)
SET DGPFRFD=30
+6 ;<--- NOTIFICATION DAYS (7)
SET DGPFNOTD=7
+7 ;<--- REVIEW MAIL GROUP (DGPF MISSING PT FLAG REVIEW)
SET DGPFRMG=$$FIND1^DIC(3.8,"","X","DGPF MISSING PT FLAG REVIEW","B")
+8 IF +DGPFRMG'>0
SET DGPFERR=" **ERROR** UNABLE TO DEFINE * "_"DGPF MISSING PT FLAG REVIEW"_" * MAIL GROUP"
DO BMES^XPDUTL(DGPFERR)
QUIT DGPFERR
+9 ;<--- TIU PN TITLE (PATIENT RECORD FLAG CATEGORY 1 - MISSING PATIENT)
SET DGPFTIU=$$FIND1^DIC(8925.1,"","X","PATIENT RECORD FLAG CATEGORY I - MISSING PATIENT","B")
+10 IF +DGPFTIU'>0
SET DGPFERR=" **ERROR** UNABLE TO DEFINE * ""PATIENT RECORD FLAG CATEGORY 1 - MISSING PATIENT"" * TIU PN TITLE"
DO BMES^XPDUTL(DGPFERR)
QUIT DGPFERR
+11 SET DGPFDSC(1)="The purpose of this flag is to identify a missing patient in the "
+12 SET DGPFDSC(2)="electronic medical record, including a Text Integration Utility (TIU) "
+13 SET DGPFDSC(3)="progress note describing the risk and circumstances."
+14 SET DGPFERR=" PRF National Flag Created: "_DGPFNM
+15 ; NAME
SET DGPFFDA(26.15,"?+1,",.01)=DGPFNM
+16 ; STATUS
SET DGPFFDA(26.15,"?+1,",.02)=DGPFSTAT
+17 ; TYPE
SET DGPFFDA(26.15,"?+1,",.03)=DGPFTYP
+18 ; REVIEW FREQUENCY DAYS
SET DGPFFDA(26.15,"?+1,",.04)=DGPFRFD
+19 ; NOTIFICATION DAYS
SET DGPFFDA(26.15,"?+1,",.05)=DGPFNOTD
+20 ; REVIEW MAIL GROUP
SET DGPFFDA(26.15,"?+1,",.06)=DGPFRMG
+21 ; TIU PN TITLE
SET DGPFFDA(26.15,"?+1,",.07)=DGPFTIU
+22 DO UPDATE^DIE("","DGPFFDA","DGPFIEN","DGPFMSG")
+23 ;D WP^DIE(file,iens,field,flags,wp_root,msg_root)
+24 if '$GET(DGPFIEN)
SET DGPFIEN=+DGPFIEN(1)
+25 ; DESCRIPTION
DO WP^DIE(26.15,DGPFIEN_",",1,"","DGPFDSC","DGPFMSG")
+26 IF $DATA(DGPFMSG)
Begin DoDot:1
+27 SET DGPFERR=" **ERROR** "_$GET(DGPFMSG("DIERR",1))_" Unable to create Patient Record Flag: "_DGPFNM
End DoDot:1
QUIT DGPFERR
+28 ; Find the IEN of the NATIONAL PRF
+29 SET DGPFIEN=$$FIND1^DIC(26.15,"","X",DGPFNM,"B")
+30 IF 'DGPFIEN
Begin DoDot:1
+31 SET DGPFERR=" **ERROR** Unable to locate NAT PRF - "_DGPFNM
End DoDot:1
QUIT DGPFERR
+32 QUIT DGPFERR
+33 ;
