Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53869P

DG53869P.m

Go to the documentation of this file.
  1. DG53869P ;CHY/TJ - DG*5.3*869 MISSING - PRF POST ROUTINE ;
  1. ;;5.3;Registration;**869**;AUG 13,1993;Build 15
  1. ;
  1. ; Post Installation Routine for patch DG*5.3*869
  1. ;
  1. EN ;
  1. D MGSETUP ; <--- Creates MailGroup (DGPF MISSING PT FLAG REVIEW) File # (3.8)
  1. D DGPFSET ; <--- Creates Patient Record Flag (MISSING PATIENT) File # (26.15)
  1. Q
  1. ;
  1. MGSETUP ;
  1. ;
  1. ;DBIA: 1146 $$MG^XMBGRP Supported
  1. ;
  1. ;This mail group API contains the entry point $$MG^XMBGRP
  1. ;Creates a mail group or add local members to an existing mail group.
  1. ;
  1. ;If the mail group does not exist, it will be created. Local
  1. ;members may be added. There is no way to add other kinds of
  1. ;members. XMTYPE, XMORG, XMSELF, and XMDESC are accepted.
  1. ;Usage: S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
  1. ;This function returns the mail group IEN if successful; 0 if not.
  1. ;
  1. ;Parameters:
  1. ;XMGROUP mail group IEN or name
  1. ;XMTYPE mail group type (public or private)
  1. ;XMORG organizer DUZ
  1. ;XMSELF self enrollment allowed?
  1. ;.XMY array of local members
  1. ;.XMDESC array of text for the mail group description
  1. ;XMQUIET silent flag
  1. ;
  1. N XMGROUP,XMTYPE,XMORG,XMSELF,XMQUIET K XMY,XMDESC S (XMY,XMDESC)="" ;new parameters
  1. S XMGROUP="DGPF MISSING PT FLAG REVIEW" ;mail group IEN or name
  1. S XMTYPE=0 ;mail group type (public or private)
  1. S XMORG=$G(XPDQUES("POS1 QUESTION"),DUZ) ;organizer (default=DUZ)
  1. S XMSELF=1 ;self enrollment allowed?
  1. S XMY="" ;array of local members
  1. 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
  1. S XMQUIET=0 ;silent flag
  1. ;
  1. N X S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
  1. D:+X>0 BMES^XPDUTL("Mail Group "_XMGROUP_" created")
  1. Q
  1. ;
  1. DGPFSET ;
  1. ;DG*5.3*869
  1. ;2.6.1. Create a new 'Missing Patient' national PRF entry in the PRF National Flag file #26.15.
  1. ;New National (Category I) PRF definition:
  1. ; Name: MISSING PATIENT
  1. ; Status: ACTIVE or INACTIVE*
  1. ; Type: CLINICAL
  1. ; Review Frequency Days: 30
  1. ; Notification Days: 7
  1. ; Review Mail Group: DGPF MISSING PT FLAG REVIEW
  1. ; TIU PN Title: PATIENT RECORD FLAG CATEGORY 1 - MISSING PATIENT
  1. ; Description:
  1. ; The purpose of this flag is to identify a missing
  1. ; patient in the electronic medical record, including
  1. ; a Text Integration Utility (TIU) progress note describing
  1. ; the risk and circumstances.
  1. ;
  1. I $$PRODPRF()'["**ERROR**" D BMES^XPDUTL("National Category I , Patient Record Flag: MISSING PATIENT created")
  1. Q
  1. ;
  1. PRODPRF() ;
  1. N DGPFERR,DGPFFDA,DGPFIEN,DGPFMSG,DGPFNM,DGPFSTAT,DGPFTYP,DGPFRFD,DGPFNOTD,DGPFRMG,DGPFTIU,DGPFDSC
  1. S DGPFNM="MISSING PATIENT" ;<--- NAT FLAG NAME (MISSING PATIENT)
  1. S DGPFSTAT=1 ;<--- ACTIVE STATUS (1)
  1. S DGPFTYP=$$FIND1^DIC(26.16,"","X","CLINICAL","B") ;<--- TYPE (CLINICAL)
  1. S DGPFRFD=30 ;<--- REVIEW FREQUENCY DAYS (30)
  1. S DGPFNOTD=7 ;<--- NOTIFICATION DAYS (7)
  1. S DGPFRMG=$$FIND1^DIC(3.8,"","X","DGPF MISSING PT FLAG REVIEW","B") ;<--- REVIEW MAIL GROUP (DGPF MISSING PT FLAG REVIEW)
  1. I +DGPFRMG'>0 S DGPFERR=" **ERROR** UNABLE TO DEFINE * "_"DGPF MISSING PT FLAG REVIEW"_" * MAIL GROUP" D BMES^XPDUTL(DGPFERR) Q DGPFERR
  1. 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)
  1. 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
  1. S DGPFDSC(1)="The purpose of this flag is to identify a missing patient in the "
  1. S DGPFDSC(2)="electronic medical record, including a Text Integration Utility (TIU) "
  1. S DGPFDSC(3)="progress note describing the risk and circumstances."
  1. S DGPFERR=" PRF National Flag Created: "_DGPFNM
  1. S DGPFFDA(26.15,"?+1,",.01)=DGPFNM ; NAME
  1. S DGPFFDA(26.15,"?+1,",.02)=DGPFSTAT ; STATUS
  1. S DGPFFDA(26.15,"?+1,",.03)=DGPFTYP ; TYPE
  1. S DGPFFDA(26.15,"?+1,",.04)=DGPFRFD ; REVIEW FREQUENCY DAYS
  1. S DGPFFDA(26.15,"?+1,",.05)=DGPFNOTD ; NOTIFICATION DAYS
  1. S DGPFFDA(26.15,"?+1,",.06)=DGPFRMG ; REVIEW MAIL GROUP
  1. S DGPFFDA(26.15,"?+1,",.07)=DGPFTIU ; TIU PN TITLE
  1. D UPDATE^DIE("","DGPFFDA","DGPFIEN","DGPFMSG")
  1. ;D WP^DIE(file,iens,field,flags,wp_root,msg_root)
  1. S:'$G(DGPFIEN) DGPFIEN=+DGPFIEN(1)
  1. D WP^DIE(26.15,DGPFIEN_",",1,"","DGPFDSC","DGPFMSG") ; DESCRIPTION
  1. I $D(DGPFMSG) D Q DGPFERR
  1. . S DGPFERR=" **ERROR** "_$G(DGPFMSG("DIERR",1))_" Unable to create Patient Record Flag: "_DGPFNM
  1. ; Find the IEN of the NATIONAL PRF
  1. S DGPFIEN=$$FIND1^DIC(26.15,"","X",DGPFNM,"B")
  1. I 'DGPFIEN D Q DGPFERR
  1. . S DGPFERR=" **ERROR** Unable to locate NAT PRF - "_DGPFNM
  1. Q DGPFERR
  1. ;