- 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 Feb 19, 2025@00:05:13 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 ;