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

MAGIP138.m

Go to the documentation of this file. 
  1. MAGIP138 ;WOIFO/PMK,NST,MAT - Install code for MAG*3.0*138 (DIX) ; 31 Jul 2013  12:20 PM
  1.  ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ; There are no environment checks here but the MAGIP138 has to be
  1.  ; referenced by the "Environment Check Routine" field of the KIDS
  1.  ; build so that entry points of the routine are available to the
  1.  ; KIDS during all installation phases.
  1.  Q
  1.  ;
  1.  ;+++++ INSTALLATION ERROR HANDLING
  1. ERROR ;
  1.  S:$D(XPDNM) XPDABORT=1
  1.  ;--- Display the messages and store them to the INSTALL file
  1.  D DUMP^MAGUERR1(),ABTMSG^MAGKIDS()
  1.  Q
  1.  ;
  1.  ;***** PRE-INSTALL CODE
  1. PRE ;
  1.  N DA,DIK
  1.  D CONVERT1
  1.  ;--- P130
  1.  ; Image Never Existed Status added to field 113 in 2005
  1.  S DIK="^DD(2006.1,",DA=113,DA(1)=2005 D ^DIK
  1.  ; Image Never Existed Status added to field 113 in 2005.1
  1.  S DIK="^DD(2006.1,",DA=113,DA(1)=2005.1 D ^DIK
  1.  Q
  1.  ;
  1.  ;***** POST-INSTALL CODE
  1. POS ;
  1.  N CALLBACK,MENU
  1.  D CLEAR^MAGUERR(1)
  1.  ;
  1.  ;=== RPC REGISTRATION ===
  1.  ;
  1.  ;--- P79 Link new remote procedures to context option MAG DICOM VISA.
  1.  S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCL079^"_$T(+0),"MAG DICOM VISA"))
  1.  I $$CP^MAGKIDS("MAG ATTACH RPCS P79",CALLBACK)<0 D ERROR Q
  1.  ;
  1.  ;--- P110 Link new remote procedures to the Broker context option.
  1.  S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCL110^"_$T(+0),"MAG WINDOWS"))
  1.  I $$CP^MAGKIDS("MAG ATTACH RPCS P110 WIN",CALLBACK)<0  D ERROR  Q
  1.  ;
  1.  ;--- P130 Link new remote procedures to context option MAG WINDOWS.
  1.  S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCL130^"_$T(+0),"MAG WINDOWS"))
  1.  I $$CP^MAGKIDS("MAG ATTACH RPCS P130",CALLBACK)<0  D ERROR  Q
  1.  ;
  1.  ;--- P136 Link new remote procedures to context option MAG DICOM VISA.
  1.  S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCL136V^"_$T(+0),"MAG DICOM VISA"))
  1.  I $$CP^MAGKIDS("MAG ATTACH RPCS P136",CALLBACK)<0 D ERROR  Q
  1.  ;
  1.  ;--- P137 Link new remote procedures to context option MAG DICOM VISA.
  1.  S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCL137V^"_$T(+0),"MAG DICOM VISA"))
  1.  I $$CP^MAGKIDS("MAG ATTACH RPCS P137",CALLBACK)<0 D ERROR  Q
  1.  ;
  1.  ;--- P138 Link new remote procedures to context option MAGTP WORKLIST MGR.
  1.  S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCL138V^"_$T(+0),"MAGTP WORKLIST MGR"))
  1.  I $$CP^MAGKIDS("MAG ATTACH RPCS P138",CALLBACK)<0 D ERROR  Q
  1.  ;
  1.  ;=== Various Updates ===
  1.  ;
  1.  ;--- P79 Add WORKLIST entry.
  1.  S CALLBACK="$$ADDWRKLS^MAGI138O()"
  1.  I $$CP^MAGKIDS("MAG ADD WORKLIST ENTRY",CALLBACK)<0 D ERROR Q
  1.  ;
  1.  ;--- P79 Add MAG WORK ITEM STATUS entries.
  1.  S CALLBACK="$$ADDSTATS^MAGI138O()"
  1.  I $$CP^MAGKIDS("MAG ADD WORK ITEM STATUS",CALLBACK)<0 D ERROR Q
  1.  ;
  1.  ;--- P79 Add StorageCommit entry to the MAG WORK ITEM SUBTYPE file.
  1.  S CALLBACK="$$ADDSUBTP^MAGI138O()"
  1.  I $$CP^MAGKIDS("MAG ADD WORK ITEM SUBTYPE",CALLBACK)<0 D ERROR Q
  1.  ;
  1.  ;--- P110 Update Driver
  1.  I $$CP^MAGKIDS("MAG P110 UPDATE","$$UPD110^"_$T(+0))<0  D ERROR  Q
  1.  ;
  1.  ;--- P130 Various Updates
  1.  I $$CP^MAGKIDS("MAG P130 UPDATE","$$UPD130^MAGI138O()")<0  D ERROR  Q
  1.  ;
  1.  ;--- P138TP Various Updates
  1.  I $$CP^MAGKIDS("MAG TP UPDATE","$$UPD138^MAGI138O()")<0 D ERROR  Q  ;UPD138
  1.  ;
  1.  ;--- Menu addition
  1.  ; Edit CLINICAL SPECIALTY DICOM & HL7 file
  1.  S MENU=$$ADD^XPDMENU("MAGD DICOM MENU","MAGD EDIT CLIN SPEC DICOM/HL7","ECS",99)
  1.  I MENU'=1 D MES^MAGKIDS("MAGD DICOM MENU option MAGD EDIT CLIN SPEC DICOM/HL7 not installed: "_MENU)
  1.  ;
  1.  ; Print DICOM Object Output File Status
  1.  S MENU=$$ADD^XPDMENU("MAGD DICOM MENU","MAGD PRINT DICOM OBJECT EXPORT","EXP",99)
  1.  I MENU'=1 D MES^MAGKIDS("MAGD DICOM MENU option MAGD PRINT DICOM OBJECT EXPORT not installed: "_MENU)
  1.  ;
  1.  D DELRTNS^MAGI138O
  1.  ; Delete MAGI138O
  1.  D
  1.  . N X,DEL
  1.  . S X="MAGI138O"
  1.  . S DEL=^%ZOSF("DEL")
  1.  . X DEL
  1.  . D MES^MAGKIDS(""""_X_""" routine has been deleted.")
  1.  . Q
  1.  ;--- Send the notification e-mail
  1.  D BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
  1.  Q
  1.  ;
  1.  ;+++++ Various updates
  1. UPD110() ;
  1.  ;
  1.  D CONVERT2
  1.  D NEW7792
  1.  D NEW7794
  1.  D ENTRYACT("MAGD RECEIVE EVENTS","D ^MAGDHOWC") ; CPRS Consult Request Tracking
  1.  D ENTRYACT("MAGD APPOINTMENT","D ^MAGDHOWS") ; SDAM Scheduling/Appointment Management
  1.  D ADTSUBS
  1.  D MAILUPDT
  1.  Q 0
  1.  ;
  1. MAILUPDT ; Add the mail group and subject for MAGDHOW* processing errors
  1.  D BMES^XPDUTL("Add CPRS DICOM & HL7 Mail Message group to the Mail Group file: "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  D ADDMG ; Add CPRS DICOM & HL7 Mail Message group to the Mail Group file (XMB(3.8)
  1.  D BMES^XPDUTL("Add Message Subject for Mail Management to Site Parameters - with interval: "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  D ADDMS(0) ; Add Message Subject for Mail Management to Site Parameters - with interval
  1.  D BMES^XPDUTL("Add CPRS DICOM & HL7 Mail groups to BP Message subfile: "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  D DLKP ; Add CPRS DICOM & HL7 Mail groups to BP Message subfile 
  1.  Q
  1.  ;
  1. CONVERT1 ; convert file 2006.5831 to the new global format - don't build indices
  1.  N CLINCNT,CLINIC,CLINIEN,CPTIEN,DIK,HL7SUBLIST,IPROCIDX,ISPECIDX
  1.  N LOCATION,NEWIEN,OLDIEN,PROCEDURE,SERVICE,X,Y
  1.  ;
  1.  I $G(^MAG(2006.5831,0))?1"CLINICAL SPECIALTY DICOM & HL7".E D  Q
  1.  . D MES^MAGKIDS("Conversion to the new format has already been performed.")
  1.  . Q
  1.  ;
  1.  L +^MAG(2006.5831):1E9
  1.  ;
  1.  D MES^MAGKIDS("Converting DICOM HEALTHCARE PROVIDER SERVICE file (#2006.5831) to new format.")
  1.  ;
  1.  K ^TMP("MAG",$J,"P110")
  1.  ;
  1.  S (NEWIEN,OLDIEN)=0
  1.  F  S OLDIEN=$O(^MAG(2006.5831,OLDIEN)) Q:'OLDIEN  D
  1.  . S NEWIEN=NEWIEN+1
  1.  . S X=^MAG(2006.5831,OLDIEN,0)
  1.  . S SERVICE=$P(X,"^",1),ISPECIDX=$P(X,"^",2),LOCATION=$P(X,"^",3)
  1.  . S (PROCEDURE,IPROCIDX,HL7SUBLIST,CPTIEN)=""
  1.  . S Y=SERVICE_"^"_PROCEDURE_"^"_ISPECIDX_"^"_IPROCIDX_"^"_LOCATION_"^"_CPTIEN_"^"_HL7SUBLIST
  1.  . S ^TMP("MAG",$J,"P110",NEWIEN,0)=Y
  1.  . S (CLINCNT,CLINIEN)=0 F  S CLINIEN=$O(^MAG(2006.5831,SERVICE,1,CLINIEN)) Q:'CLINIEN  D
  1.  . . S CLINCNT=CLINCNT+1,CLINIC=^MAG(2006.5831,SERVICE,1,CLINIEN,0)
  1.  . . S ^TMP("MAG",$J,"P110",NEWIEN,1,CLINCNT,0)=CLINIC
  1.  . . Q
  1.  . I CLINCNT S ^TMP("MAG",$J,"P110",NEWIEN,1,0)="^2006.58311^"_CLINCNT_"^"_CLINCNT
  1.  . Q
  1.  S ^TMP("MAG",$J,"P110",0)="CLINICAL SPECIALTY DICOM & HL7^2006.5831P^"_NEWIEN_"^"_NEWIEN
  1.  S DIK="^MAG(2006.5831,"
  1.  D ENALL2^DIK  ; Delete all cross-reference
  1.  L -^MAG(2006.5831)
  1.  ;
  1.  ; Delete DICOM HEALTHCARE PROVIDER SERVICE file (#2006.5831) 
  1.  D DELFILE^MAGKIDS(2006.5831,"DE","")
  1.  Q
  1.  ;
  1. CONVERT2 ; restore the new file 2006.5831 and build cross-references
  1.  N DIK
  1.  ;
  1.  I $G(^MAG(2006.5831,0))?1"CLINICAL SPECIALTY DICOM & HL7".E,$P(^(0),"^",4) D  Q
  1.  . D MES^MAGKIDS("Conversion to the new format has already been performed.")
  1.  . Q
  1.  ;
  1.  ; Update file #2006.5831 security here because of the FileMan bug
  1.  N SECURITY
  1.  S SECURITY("AUDIT")="@"
  1.  S SECURITY("DD")="@"
  1.  S SECURITY("DEL")="@"
  1.  S SECURITY("LAYGO")="@"
  1.  S SECURITY("RD")="@"
  1.  S SECURITY("WR")="@"
  1.  D FILESEC^DDMOD(2006.5831,.SECURITY)  ; supported ICR #2916
  1.  ;
  1.  L +^MAG(2006.5831):1E9
  1.  K ^MAG(2006.5831)
  1.  M ^MAG(2006.5831)=^TMP("MAG",$J,"P110")
  1.  K ^TMP("MAG",$J,"P110")
  1.  S DIK="^MAG(2006.5831," D IXALL^DIK ; create all the cross-references
  1.  D MES^MAGKIDS("Conversion to CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831) complete.")
  1.  L -^MAG(2006.5831)
  1.  Q
  1.  ;
  1. NEW7792 ; create the MAGD SENDER entry in the HLO APPLICATION REGISTRY (file 779.2)
  1.  N DESCRIPTION,DIC,DIERR,I,IENS,MAGERR,MAGFDA,MAGIENS,NAME,PACKAGE,OWNER,X,Y
  1.  ;
  1.  S NAME="MAGD SENDER"
  1.  ;
  1.  ; check to see if <NAME> already exists
  1.  S DIC=779.2,DIC(0)="BX",X=NAME D ^DIC
  1.  I Y>0 D  Q
  1.  . D MES^MAGKIDS(""""_NAME_""" already exists in the HLO APPLICATION REGISTRY.")
  1.  . Q
  1.  ;
  1.  ; get package file number for IMAGING
  1.  S DIC=9.4,DIC(0)="BX",X="IMAGING" D ^DIC
  1.  I Y=-1 D  Q
  1.  . D MES^MAGKIDS("""IMAGING"" does not exist in the PACKAGE file (#9.4).")
  1.  . Q
  1.  S PACKAGE=+Y
  1.  ;
  1.  S IENS="+1,"
  1.  S MAGFDA(779.2,IENS,.01)=NAME        ; APPLICATION NAME
  1.  S MAGFDA(779.2,IENS,2)=PACKAGE       ; PACKAGE FILE LINK
  1.  D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
  1.  I $D(DIERR) D  Q
  1.  . D MES^MAGKIDS("Error in creating """_NAME_""" in the HLO APPLICATION REGISTRY.")
  1.  . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I))  D
  1.  . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. NEW7794 ; create the entries in the HLO SUBSCRIPTION REGISTRY (file 779.4)
  1.  N DESCRIPTION,NAME,OWNER
  1.  ;
  1.  ; create the MAGD ADT entry
  1.  S NAME="MAGD ADT"
  1.  S DESCRIPTION="ADT subscription list for clinical specialty systems"
  1.  S OWNER="MAGD (ADT)"
  1.  D NEW7794A(NAME,DESCRIPTION,OWNER)
  1.  ;
  1.  ; create the MAGD DEFAULT entry
  1.  S NAME="MAGD DEFAULT"
  1.  S DESCRIPTION="Default subscription list for CPRS consults & procedures"
  1.  S OWNER="MAGD (Imaging Default)"
  1.  D NEW7794A(NAME,DESCRIPTION,OWNER)
  1.  ;
  1.  Q
  1.  ;
  1. NEW7794A(NAME,DESCRIPTION,OWNER) ; create the entry in file 779.4
  1.  N DIC,DIERR,I,IENS,MAGERR,MAGFDA,MAGIENS,X,Y
  1.  ;
  1.  ; check to see if <NAME> already exists
  1.  S DIC=779.4,DIC(0)="BX",X=NAME D ^DIC
  1.  I Y>0 D  Q
  1.  . D MES^MAGKIDS(""""_NAME_""" already exists in the HLO SUBSCRIPTION REGISTRY.")
  1.  . Q
  1.  ;
  1.  S IENS="+1,"
  1.  S MAGFDA(779.4,IENS,.01)=NAME        ; NAME
  1.  S MAGFDA(779.4,IENS,.02)=OWNER       ; OWNER
  1.  S MAGFDA(779.4,IENS,.03)=DESCRIPTION ; DESCRIPTION
  1.  D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
  1.  I $D(DIERR) D  Q
  1.  . D MES^MAGKIDS("Error in creating """_NAME_""" in the HLO SUBSCRIPTION REGISTRY.")
  1.  . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I))  D
  1.  . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. ENTRYACT(PROTOCOL,ACTION) ; update the protocol's ENTRY ACTION
  1.  N DIC,IENS,MAGERR,MAGFDA,MAGIENS,X,Y
  1.  S DIC=101,DIC(0)="BX",X=PROTOCOL D ^DIC
  1.  I Y=-1 D  Q
  1.  . D MES^MAGKIDS("Error in updating protocol "_X_" - it is not defined.")
  1.  . Q
  1.  S IENS=+Y_","
  1.  S MAGFDA(101,IENS,20)=ACTION        ; ENTRY ACTION
  1.  D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
  1.  I $D(DIERR) D  Q
  1.  . D MES^MAGKIDS("Error in updating protocol "_X_".")
  1.  . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I))  D
  1.  . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. ADTSUBS ; add new subscribers to MAG CPACS A01 - A13 ADT event drives
  1.  ;
  1.  D ADTSUBS1("A01","inpatient admission")
  1.  D ADTSUBS1("A02","patient transfer")
  1.  D ADTSUBS1("A03","patient discharge")
  1.  D ADTSUBS1("A11","admission cancellation")
  1.  D ADTSUBS1("A12","transfer cancellation")
  1.  D ADTSUBS1("A13","discharge cancellation")
  1.  ;
  1.  Q
  1.  ;
  1. ADTSUBS1(EVENT,TYPE) ; add one subscriber
  1.  N DESCRIPTION,EVENTDRIVER,EVENTDRIVERIEN,ITEMTEXT,SUBSCRIBER,SUBSCRIBERIEN
  1.  N DIC,IENS,MAGERR,MAGFDA,MAGIENS,X,Y
  1.  ;
  1.  S EVENTDRIVER="MAG CPACS "_EVENT,SUBSCRIBER=EVENTDRIVER_" SUBS-HLO"
  1.  S ITEMTEXT="Routes "_TYPE_"s using HLO"
  1.  S DESCRIPTION(1)="This protocol routes "_TYPE_" messages"
  1.  S DESCRIPTION(2)="a commercial PACS using the HL7 Optimized package."
  1.  ;
  1.  ;
  1.  ; first, find the event driver protocol - it must exist
  1.  S DIC=101,DIC(0)="BX",X=EVENTDRIVER D ^DIC
  1.  I Y=-1 D  Q
  1.  . D MES^MAGKIDS("Error in updating protocol "_X_" - it is not defined.")
  1.  . Q
  1.  S EVENTDRIVERIEN=+Y
  1.  ;
  1.  ;
  1.  ; second, find the HLO subscriber protocol - it shouldn't exist
  1.  S DIC=101,DIC(0)="BX",X=SUBSCRIBER D ^DIC
  1.  I Y'=-1 D  Q
  1.  . D MES^MAGKIDS("Note: Updating protocol "_X_" - it is already defined.")
  1.  . Q
  1.  ;
  1.  ;
  1.  ; third, create the HLO subscriber protocol
  1.  S IENS="+1,"
  1.  S MAGFDA(101,IENS,.01)=SUBSCRIBER           ; NAME
  1.  S MAGFDA(101,IENS,1)=ITEMTEXT               ; ITEM TEXT
  1.  S MAGFDA(101,IENS,3.5)="DESCRIPTION"        ; DESCRIPTION (wp field)
  1.  S MAGFDA(101,IENS,4)="S"                    ; TYPE (subscriber)
  1.  S MAGFDA(101,IENS,5)=DUZ                    ; CREATOR
  1.  S MAGFDA(101,IENS,99)=$H                    ; TIMESTAMP
  1.  S MAGFDA(101,IENS,770.2)="MAGD-CLIENT"      ; RECEIVING APPLICATION <------------------------
  1.  S MAGFDA(101,IENS,770.3)="ADT"              ; TRANSACTION MESSAGE TYPE
  1.  S MAGFDA(101,IENS,770.4)=EVENT              ; EVENT TYPE
  1.  S MAGFDA(101,IENS,770.11)="ACK"             ; RESPONSE MESSAGE TYPE
  1.  S MAGFDA(101,IENS,771)="D ENTRY^MAGDHOWA"   ; PROCESSING ROUTINE
  1.  D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
  1.  I $D(DIERR) D  Q
  1.  . D MES^MAGKIDS("Error in updating subscriber protocol "_X_".")
  1.  . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I))  D
  1.  . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
  1.  . . Q
  1.  . Q
  1.  S SUBSCRIBERIEN=MAGIENS(1)
  1.  ;
  1.  ; fourth, add the new HLO subscriber to the event driver protocol
  1.  S IENS="+2,"_EVENTDRIVERIEN_","
  1.  S MAGFDA(101.0775,IENS,.01)=SUBSCRIBERIEN
  1.  D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
  1.  I $D(DIERR) D  Q
  1.  . D MES^MAGKIDS("Error in updating event driver protocol "_X_".")
  1.  . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I))  D
  1.  . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1.  ; code to handle adding a mail message for MAGDHOW* errors
  1.  ;
  1. ADDMS(INTERVAL) ; Add Message Subjects for Mail Management
  1.  N I,J,K,MAGFDA,MSG,IEN,MAGERR
  1.  S IEN=0
  1.  F  S IEN=$O(^MAG(2006.1,IEN)) Q:'IEN  D
  1.  . F J=1:1:1 S K=$P($T(TEXT+J),";",3) D
  1.  . . Q:$D(^MAG(2006.1,IEN,6,"B",K))  ; Do not re-configure
  1.  . . S MAGFDA(2006.166,"?+1,"_IEN_",",.01)=K
  1.  . . S MAGFDA(2006.166,"?+1,"_IEN_",",1)=INTERVAL
  1.  . . D UPDATE^DIE("","MAGFDA","","MAGERR")
  1.  . . I $D(DIERR) D BMES^XPDUTL("Error updating the BP Mail Message Subfile: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR
  1.  . . Q
  1.  . Q
  1.  Q
  1. ADDMG ; Add Mail Message groups to the Mail Group file (XMB(3.8))
  1.  N PL,NMSP
  1.  S PL=0
  1.  F  S PL=$O(^MAG(2006.1,PL)) Q:'PL  D
  1.  . S NMSP=$P($G(^MAG(2006.1,PL,0)),U,2)
  1.  . Q:NMSP=""
  1.  . D ADD(NMSP)
  1.  . D ADDDUZ(NMSP)
  1.  . Q
  1.  Q 
  1. ADD(NMSP) ;
  1.  N J,K,L,MAGFDA,MSG,IEN,MAGIEN,MAGERR
  1.  F J=1:1:1 S K=$P($T(TEXT+J),";",3) D
  1.  . I '$D(^XMB(3.8,"B","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20))) D
  1.  . . S L=$O(^XMB(3.8,"B","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20),""))
  1.  . . S MAGFDA(3.8,"?+"_J_",",.01)="MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20)
  1.  . . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
  1.  . . I $D(DIERR) D BMES^XPDUTL("Error Adding Imaging Mail Groups: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR,MAGFDA Q
  1.  . . K MAGFDA,DIERR,MAGERR
  1.  . . S MAGFDA(3.8,MAGIEN(J)_",",4)="PU"
  1.  . . D FILE^DIE("I","MAGFDA","MAGERR")
  1.  . . K DIERR,MAGERR,MAGFDA,MAGIEN
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. ADDDUZ(NMSP) ;
  1.  N J,K,L,MAGFDA,MSG,IEN,MAGIEN,MAGERR
  1.  F J=1:1:1 S K=$P($T(TEXT+J),";",3) D
  1.  . S L=$O(^XMB(3.8,"B","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20),""))
  1.  . S MAGFDA(3.81,"?+1,"_L_",",.01)=DUZ
  1.  . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
  1.  . I $D(DIERR) D BMES^XPDUTL("Error Adding Imaging Mail Group member: "_MAGERR("DIERR",1,"TEXT",1))
  1.  . K DIERR,MAGERR,MAGFDA,MAGIEN
  1.  Q
  1.  ;
  1. DLKP ; Add Generic Mail groups to BP Message subfile
  1.  N PL,I,J,MAGFDA,MSGROOT,MG,DIERR,MAGIEN,MAGERR,NMSP
  1.  S PL=0
  1.  F  S PL=$O(^MAG(2006.1,PL)) Q:'PL  D
  1.  . S I=0,NMSP=$P($G(^MAG(2006.1,PL,0)),U,2)
  1.  . Q:NMSP=""
  1.  . F  S I=$O(^MAG(2006.1,PL,6,I)) Q:'I  D
  1.  . . S MG=$P($G(^MAG(2006.1,PL,6,I,0)),"^",1)
  1.  . . S J=$$FIND1^DIC(3.8,"","","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(MG),1,20),"","","MSGROOT")
  1.  . . Q:$D(^MAG(2006.1,PL,6,I,1,"B",J))  ; Do not re-configure
  1.  . . I J  D
  1.  . . . S MAGFDA(2006.1662,"+1,"_I_","_PL_",",.01)=J
  1.  . . . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
  1.  . . . I $D(DIERR) D BMES^XPDUTL("Error Adding Generic Mail Groups: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  K MAGFDA,MSGROOT,MAGIEN,MSGROOT
  1.  Q
  1. TEXT ; Message Subjects
  1.  ;;CPRS_DICOM_and_HL7
  1.  Q
  1.  ;+++++ LIST OF NEW REMOTE PROCEDURES
  1.  ; have a list in format ;;MAG4 IMAGE LIST
  1. RPCL110 ;
  1.  ;;MAG3 TELEREADER CPT CODELOOKUP
  1.  Q
  1. RPCL130 ;
  1.  ;;MAG GET DICOM QUEUE LIST
  1.  ;;MAG SEND IMAGE
  1.  ;;MAGV CREATE WORK ITEM
  1.  ;;MAGV GET WORK ITEM
  1.  ;;MAGV GET NEXT WORK ITEM
  1.  ;;MAGV FIND WORK ITEM
  1.  ;;MAGV UPDATE WORK ITEM
  1.  ;;MAGV ADD WORK ITEM TAGS
  1.  ;;MAGV DELETE WORK ITEM
  1.  Q
  1.  ;
  1. RPCL079 ;
  1.  ;;MAG DICOM CHECK AE TITLE
  1.  ;;MAG DICOM GET AE ENTRY
  1.  ;;MAG DICOM GET AE ENTRY LOC
  1.  ;;MAGVC WI DELETE
  1.  ;;MAGVC WI GET
  1.  ;;MAGVC WI LIST
  1.  ;;MAGVC WI SUBMIT NEW
  1.  ;;MAGVC WI UPDATE STATUS
  1.  Q
  1.  ;
  1. RPCL136V ;
  1.  ;;MAGV GET RAD DX CODES
  1.  ;;MAGV GET RAD IMAGING LOCATIONS
  1.  ;;MAGV GET RAD STD RPTS
  1.  ;;MAGV GENERATE DICOM UID
  1.  Q
  1.  ;
  1. RPCL137V ;
  1.  ;;MAGV GET IRRADIATION DOSE
  1.  ;;MAGV ATTACH IRRADIATION DOSE
  1.  Q
  1.  ;
  1. RPCL138V ;
  1.  ;;MAGTP GET ACTIVE
  1.  ;;MAGTP GET CASES
  1.  ;;MAGTP GET CPRS REPORT
  1.  ;;MAGTP GET NOTE
  1.  ;;MAGTP GET PREFERENCES
  1.  ;;MAGTP GET RETENTION DAYS
  1.  ;;MAGTP GET SLIDES
  1.  ;;MAGTP GET USER
  1.  ;;MAGTP PUT NOTE
  1.  ;;MAGTP PUT PREFERENCES
  1.  ;;MAGTP RESERVE CASE
  1.  ;;MAGTP SET RETENTION DAYS
  1.  ;;MAGTP USER
  1.  ;;MAGG GET TIMEOUT
  1.  ;;MAGG INSTALL
  1.  ;;MAGG PAT INFO
  1.  ;;MAGG VERIFY ESIG
  1.  ;;MAGGUPREFGET
  1.  ;;MAGGUPREFSAVE
  1.  ;;MAGGUSERKEYS
  1.  ;;MAG BROKER SECURITY
  1.  ;;VAFCTFU CONVERT DFN TO ICN
  1.  ;;VAFCTFU CONVERT ICN TO DFN
  1.  ;;DG SENSITIVE RECORD ACCESS
  1.  ;;DG SENSITIVE RECORD BULLETIN
  1.  ;;XWB CREATE CONTEXT
  1.  ;;MAG3 SET TIMEOUT
  1.  ;;MAGGHSLIST
  1.  ;;MAGGHS
  1.  Q
  1.  ;
  1.  ; MAGIP138