MAGNTLRS.m

MAGNTLRS ;WOIFO/NST - TeleReader Configuration  ; 23 Apr 2012 2:30 PM

 ;;3.0;IMAGING;**114,127,138**;Mar 19, 2002;Build 5380;Sep 03, 2013

 ;; Per VHA Directive 2004-038, this routine should not be modified.

 ;; +---------------------------------------------------------------+

 ;; | Property of the US Government.                                |

 ;; | No permission to copy or redistribute this software is given. |

 ;; | Use of unreleased versions of this software requires the user |

 ;; | to execute a written test agreement with the VistA Imaging    |

 ;; | Development Office of the Department of Veterans Affairs,     |

 ;; | telephone (301) 734-0100.                                     |

 ;; | The Food and Drug Administration classifies this software as  |

 ;; | a medical device.  As such, it may not be changed in any way. |

 ;; | Modifications to this software may result in an adulterated   |

 ;; | medical device under 21CFR820, the use of which is considered |

 ;; | to be a violation of US Federal Statutes.                     |

 ;; +---------------------------------------------------------------+

 ;;

 Q

 ;

 ;***** Add/Update/Delete a service in TELEREADER ACQUISITION SERVICE file (#2006.5841)

 ; RPC: MAG3 TELEREADER ACQ SRVC SETUP

 ;

 ; Input Parameters

 ; ================

 ;   Delete action:

 ;     MAGPARAM("ACTION")           = "DELETE"

 ;     MAGPARAM("IEN")              = IEN of the record that will be deleted

 ;   Add or Update action:

 ;     MAGPARAM("ACTION")           = "ADD" or "UPDATE"

 ;     MAGPARAM("NAME")             = A pointer to REQUEST SERVICES file (#123.5)

 ;     MAGPARAM("PROCEDURE")        = A pointer to GMRC PROCEDURE file (#123.5)

 ;     MAGPARAM("SPECIALTY INDEX")  = A pointer to the SPECIALTY file (#2005.84)

 ;     MAGPARAM("PROCEDURE INDEX")  = A pointer to the PROCEDURE/EVENT file (#2005.85)

 ;     MAGPARAM("ACQUISITION SITE") = A pointer to the INSTITUTION file (#4) 

 ;     MAGPARAM("UNREAD LIST CREATION TRIGGER") = I/O/F

 ;     MAGPARAM("TIU NOTE FILE")    = A pointer to TIU DOCUMENT file (#8925.1)

 ; 

 ; Return Values

 ; =============

 ; if error MAGRY = "0^Error"

 ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 ;                               or IEN of the added record

 ;

UASRVC(MAGRY,MAGPARAM) ;RPC [MAG3 TELEREADER ACQ SRVC SETUP]

 ;

 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"

 ;

 N X,MAGNFDA,MAGNIEN,MAGNXE,IENS,MAGRESA

 N DA,DIK

 ;

 ;^MAG(2006.5841,D0,0)=1=NAME, 2=PROCEDURE, 3=SPECIALTY INDEX, 4=PROCEDURE INDEX,

 ;                     5=ACQUISITION SITE, 6=UNREAD LIST CREATION TRIGGER, 7=TIU NOTE FILE

 ;

 I MAGPARAM("ACTION")="DELETE" D  Q  ; Delete an entry IEN and exit

 . S DIK="^MAG(2006.5841,"

 . S DA=MAGPARAM("IEN")

 . D ^DIK

 . S MAGRY=1

 . Q

 ;

 S MAGRY=""

 I MAGPARAM("ACTION")="ADD" D  Q:MAGRY'=""  ; Quit if a service already exists

 . D FIND^DIC(2006.5841,"","@;IX","PQX",MAGPARAM("NAME"),"1","B","","","X")

 . I $D(X("DILIST","1",0)) S MAGRY="0^Service already exists"

 . S IENS="+1,"

 E  S IENS=MAGPARAM("IEN")_",",MAGNIEN(1)=MAGPARAM("IEN")

 ;  

 S MAGNFDA(2006.5841,IENS,.01)=MAGPARAM("NAME")

 S MAGNFDA(2006.5841,IENS,1)=MAGPARAM("PROCEDURE")

 S MAGNFDA(2006.5841,IENS,2)=MAGPARAM("SPECIALTY INDEX")

 S MAGNFDA(2006.5841,IENS,3)=MAGPARAM("PROCEDURE INDEX")

 S MAGNFDA(2006.5841,IENS,4)=MAGPARAM("ACQUISITION SITE")

 S MAGNFDA(2006.5841,IENS,5)=MAGPARAM("UNREAD LIST CREATION TRIGGER")

 S MAGNFDA(2006.5841,IENS,6)=MAGPARAM("TIU NOTE FILE")

 ;

 D UPDATE^DIE("SK","MAGNFDA","MAGNIEN","MAGNXE")

 ;

 I $D(MAGNXE("DIERR","E")) D  Q

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . S MAGRY="0^"_MAGRESA(1)

 . Q

 E  S MAGRY="1^"_MAGNIEN(1)

 Q

 ;

 ;***** Add/Update/Delete a service in DICOM HEALTHCARE PROVIDER SERVICE file (#2006.5831)

 ; RPC: MAG3 TELEREADER PDR SRVC SETUP

 ;

 ; Input Parameters

 ; ================

 ;   Delete action:

 ;     MAGPARAM("ACTION")            = "DELETE"

 ;     MAGPARAM("IEN")               = IEN of the record that will be deleted

 ;   Add or Update action:

 ;     MAGPARAM("ACTION")            = "ADD" or "UPDATE"

 ;     MAGPARAM("REQUEST SERVICE") = A pointer to the "Request Services" file (#123.5)

 ;     MAGPARAM("PROCEDURE")        = A pointer to GMRC PROCEDURE file (#123.3)

 ;     MAGPARAM("SPECIALTY INDEX")  = A pointer to SPECIALTY file (#2005.84)

 ;     MAGPARAM("PROCEDURE INDEX")  = A pointer to PROCEDURE/EVENT file (#2005.85)

 ;     MAGPARAM("ACQUISITION SITE") = A pointer to INSTITUTION file (#4) 

 ;     MAGPARAM("CPT CODE")         = A pointer to CPT file (#81)

 ;     MAGPARAM("HL7 HLO SUBSCRIPTION LIST") = A pointer to HLO SUBSCRIPTION REGISTRY file (#779.4)

 ;     MAGPARAM("CLINIC")            = "^" delimited string with clinics IENS in file (#44)

 ; 

 ; Return Values

 ; =============

 ; if error MAGRY = "0^Error"

 ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 ;                               or IEN of the added record

 ;

UPSRVC(MAGRY,MAGPARAM) ;RPC [MAG3 TELEREADER PDR SRVC SETUP]

 ;

 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"

 ;

 N X,MAGNFDA,MAGNIEN,MAGNXE,IENS,IEN,MAGRESA

 N DA,DIK

 ;

 ;^MAG(2006.5831,D0,0)=1=REQUEST SERVICE, 2=PROCEDURE, 3=SPECIALTY INDEX, 4=PROCEDURE INDEX

 ;                     5=ACQUSITION SITE, 6=CPT CODE, 7=HL7 HLO SUBSCRIPTION LIST

 ;

 I MAGPARAM("ACTION")="DELETE" D  Q  ; Delete an entry IEN and exit

 . S DIK="^MAG(2006.5831,"

 . S DA=MAGPARAM("IEN")

 . D ^DIK

 . S MAGRY=1

 . Q

 ;

 S MAGRY=""

 I MAGPARAM("ACTION")="ADD" D  Q:MAGRY'=""  ; Quit if a service,procedure already exists

 . I $$IREQUEST^MAGDHOW1(MAGPARAM("REQUEST SERVICE"),MAGPARAM("PROCEDURE"))>0 S MAGRY="0^Service/Procedure pair already exists." Q

 . S IENS="+1,"

 . Q

 E  S IENS=MAGPARAM("IEN")_",",MAGNIEN(1)=MAGPARAM("IEN") ; ACTION = UPDATE

 ;  

 S MAGNFDA(2006.5831,IENS,.01)=MAGPARAM("REQUEST SERVICE") ; REQUEST SERVICE

 S MAGNFDA(2006.5831,IENS,2)=MAGPARAM("PROCEDURE")           ; PROCEDURE

 S MAGNFDA(2006.5831,IENS,3)=MAGPARAM("SPECIALTY INDEX")     ; SPECIALTY INDEX

 S MAGNFDA(2006.5831,IENS,4)=MAGPARAM("PROCEDURE INDEX")     ; PROCEDURE INDEX

 S MAGNFDA(2006.5831,IENS,5)=MAGPARAM("ACQUISITION SITE")     ; ACQUISITION SITE

 S MAGNFDA(2006.5831,IENS,6)=MAGPARAM("CPT CODE")            ; CPT CODE

 S MAGNFDA(2006.5831,IENS,7)=MAGPARAM("HL7 HLO SUBSCRIPTION LIST")     ; HL7 HLO SUBSCRIPTION LIST

 ;

 D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")

 ;

 I $D(MAGNXE("DIERR","E")) D  Q

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . S MAGRY="0^"_MAGRESA(1)

 . Q

 ;

 I $D(MAGPARAM("CLINIC")) I '$$UCLINIC^MAGNTLRS(.MAGRY,MAGPARAM("CLINIC"),MAGNIEN(1)) Q

 ;

 S MAGRY="1^"_MAGNIEN(1)

 Q

 ; #######################

 ; UCLINIC -  Update Clinic multiple field in file #2006.5831

 ;

 ; Returns 0 if failed

 ;         1 success

 ; Input parameters

 ;   CLINS = "^" delimited string with clinics IENS

 ;   IEN   = IEN in file #2006.5831

 ;

 ; Output parameters

 ;   RES = "0^Error"

 ;

UCLINIC(RES,CLINS,IEN) ; Update Clinic field in file #2006.58311  (old #2006.58314)

 N CLIN,CLINA,OUT,MSG,I

 N DA,DIK

 N MAGNFDA,MAGNXE,MAGNIEN

 S RES=""

 D LIST^DIC(2006.58311,","_IEN_",","@;.01I","",,,,,,,"OUT","MSG")

 I $D(MSG("DIERR","E")) S RES="0^Error updating CLINIC field" Q 0

 ;

 S DA(1)=IEN  ; set the variables so we can perform deletion of multiple if needed

 S DIK="^MAG(2006.5831,"_IEN_",1,"

 ;

 F I=1:1 S CLIN=$P(CLINS,"^",I) Q:CLIN=""  S CLINA(CLIN)=""

 ;

 ; delete multiple if they are not present in CLINA (CLINS)

 S I=0

 F  S I=$O(OUT("DILIST","ID",I)) Q:'I  D

 . S CLIN=OUT("DILIST","ID",I,".01")

 . I $D(CLINA(CLIN)) K CLINA(CLIN) Q   ; The Clin ID exists in multiple. Delete from CLINA and continue

 . S DA=OUT("DILIST","2",I)

 . D ^DIK

 . Q 

 ;

 ; insert the new multiples

 S CLIN=""

 F  S CLIN=$O(CLINA(CLIN)) Q:CLIN=""  Q:RES'=""  D

 . K MAGNFDA,MAGNXE,MAGNIEN

 . S MAGNFDA(2006.58311,"+1,"_IEN_",",.01)=CLIN

 . D UPDATE^DIE("","MAGNFDA","","MAGNXE")

 . I $D(MAGNXE("DIERR","E")) S RES="0^Error inserting CLINIC field " Q

 . Q

 Q $S(RES="":1,1:0)  ; return 

 ;

 ;***** Add/Update/Delete a site in TELEREADER ACQUISITION SITE file (#2006.5842)

 ; RPC: MAG3 TELEREADER SITE SETUP

 ;

 ; Input Parameters

 ; ================

 ;   Delete action:

 ;     MAGPARAM("ACTION")                  = "DELETE"

 ;     MAGPARAM("IEN")                     = IEN of the record that will be deleted

 ;   Add or Update action:

 ;     MAGPARAM("ACTION")                  = "ADD" or "UPDATE"

 ;     MAGPARAM("NAME")                    = A pointer to the INSTITUTION file (#4)

 ;     MAGPARAM("PRIMARY SITE")            = A pointer to the INSTITUTION file (#4)

 ;     MAGPARAM("STATUS")                  = 0 or 1 (Active or Inactive)

 ;     MAGPARAM("LOCK TIMEOUT IN MINUTES") = value of field #3 of file (#2006.5842)

 ;

 ; Return Values

 ; =============

 ; if error MAGRY = "0^Error"

 ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 ;                               or IEN of the added record

 ;

USITE(MAGRY,MAGPARAM) ;RPC [MAG3 TELEREADER SITE SETUP]

 ;

 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"

 ;

 N X,MAGNFDA,MAGNIEN,MAGNXE,IENS,MAGRESA

 N DA,DIK

 ;

 ;^MAG(2006.5842,D0,0)=1=NAME,2=PRIMARY SITE,3=STATUS,4=LOCK TIMEOUT IN MINUTES

 ;

 I MAGPARAM("ACTION")="DELETE" D  Q  ; Delete an entry IEN and exit

 . S DIK="^MAG(2006.5842,"

 . S DA=MAGPARAM("IEN")

 . D ^DIK

 . S MAGRY=1

 . Q

 ;

 S MAGRY=""

 I MAGPARAM("ACTION")="ADD" D  Q:MAGRY'=""  ; Quit if a record already exists

 . D FIND^DIC(2006.5842,"","@;IX","PQX",MAGPARAM("NAME"),"1","B","","","X")

 . I $D(X("DILIST","1",0)) S MAGRY="0^Record already exists"

 . S IENS="+1,"

 E  S IENS=MAGPARAM("IEN")_","

 ;

 S MAGNIEN(1)=MAGPARAM("NAME") ; if you add a new item using P^DI the new IEN will be value of field "NAME" (#.01)

 S MAGNFDA(2006.5842,IENS,.01)=MAGPARAM("NAME")

 S MAGNFDA(2006.5842,IENS,1)=MAGPARAM("PRIMARY SITE")

 S MAGNFDA(2006.5842,IENS,2)=MAGPARAM("STATUS")

 S MAGNFDA(2006.5842,IENS,3)=MAGPARAM("LOCK TIMEOUT IN MINUTES")

 ;

 D UPDATE^DIE("SK","MAGNFDA","MAGNIEN","MAGNXE")

 ;

 I $D(MAGNXE("DIERR","E")) D  Q

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . S MAGRY="0^"_MAGRESA(1)

 . Q

 E  S MAGRY="1^"_MAGNIEN(1)

 Q

 ;

 ;*****  Add/Update/Delete TELEREADER READER file (#2006.5843)

 ; RPC: MAG3 TELEREADER READER SETUP

 ;

 ; Input Parameters

 ; ================

 ;   Delete actions:

 ;     Reader

 ;       MAGPARAM("ACTION") = "DELETE READER"

 ;       MAGPARAM("READER") = Reader internal value

 ;     Acquisition Site

 ;       MAGPARAM("ACTION")           = "DELETE SITE"

 ;       MAGPARAM("READER")           = Reader internal value

 ;       MAGPARAM("ACQUISITION SITE") = Acquisition Site internal value

 ;     Specialty

 ;       MAGPARAM("ACTION")           = "DELETE SPECIALTY"

 ;       MAGPARAM("READER")           = Reader internal value

 ;       MAGPARAM("ACQUISITION SITE") = Acquisition Site internal value

 ;       MAGPARAM("SPECIALTY INDEX")  = Specialty Index internal value

 ;     Procedure

 ;       MAGPARAM("ACTION")           = "DELETE PROCEDURE"

 ;       MAGPARAM("READER")           = Reader internal value

 ;       MAGPARAM("ACQUISITION SITE") = Acquisition Site internal value

 ;       MAGPARAM("SPECIALTY INDEX")  = Specialty Index internal value

 ;       MAGPARAM("PROCEDURE INDEX")  = Procedure Index internal value

 ;   Update Status field:

 ;     Acquisition Site

 ;       MAGPARAM("ACTION")           = "SET SITE STATUS"

 ;       MAGPARAM("READER")           = Reader internal value

 ;       MAGPARAM("ACQUISITION SITE") = Acquisition Site internal value

 ;       MAGPARAM("ACQUISITION SITE STATUS") = 0 or 1 (Active or Inactive)

 ;     Specialty 

 ;       MAGPARAM("ACTION")           = "SET SPECIALTY STATUS"

 ;       MAGPARAM("READER")           = Reader internal value

 ;       MAGPARAM("ACQUISITION SITE") = Acquisition Site internal value

 ;       MAGPARAM("SPECIALTY INDEX")  = Specialty Index internal value

 ;       MAGPARAM("SPECIALTY INDEX STATUS") = 0 or 1 (Active or Inactive)

 ;     Procedure

 ;       MAGPARAM("ACTION")           = "SET PROCEDURE STATUS"

 ;       MAGPARAM("READER")           = Reader internal value

 ;       MAGPARAM("ACQUISITION SITE") = Acquisition Site internal value

 ;       MAGPARAM("SPECIALTY INDEX")  = Specialty Index internal value

 ;       MAGPARAM("PROCEDURE INDEX")  = Procedure Index internal value

 ;       MAGPARAM("PROCEDURE STATUS") = 0 or 1 (Active or Inactive)

 ;   Add action:

 ;     MAGPARAM("ACTION")           = "ADD"

 ;     MAGPARAM("READER")           = Reader internal value

 ;     MAGPARAM("ACQUISITION SITE") = Acquisition Site internal value

 ;     MAGPARAM("ACQUISITION SITE STATUS") = Acquisition Site Status

 ;     MAGPARAM("SPECIALTY INDEX")  = Specialty Index internal value

 ;     MAGPARAM("SPECIALTY INDEX STATUS") = Specialty Index Status

 ;     MAGPARAM("PROCEDURE INDEX")  = Procedure Index internal value

 ;     MAGPARAM("PROCEDURE INDEX STATUS") = 0 or 1 (Active or Inactive)

 ;     MAGPARAM("PROCEDURE INDEX USER PREFERENCE") = 0 or 1 (Active or Inactive)

 ;

 ; Return Values

 ; =============

 ; if error MAGRY = "0^Error"

 ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 ;                               or IEN of the added record

 ;

UREADER(MAGRY,MAGPARAM) ;RPC [MAG3 TELEREADER READER SETUP]

 ;

 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"

 ;

 N MAGNFDA,MAGNIEN,MAGNXE,MAGRESA

 ;

 I MAGPARAM("ACTION")="DELETE READER" D  Q  ; Delete an entry and exit

 . D DREADER(.MAGPARAM)

 . S MAGRY=1

 . Q

 ;

 I MAGPARAM("ACTION")="DELETE SITE" D  Q  ; Delete an entry and exit

 . D DACQSITE(.MAGPARAM)

 . S MAGRY=1

 . Q

 ;

 I MAGPARAM("ACTION")="DELETE SPECIALTY" D  Q  ; Delete an entry and exit

 . D DSPECIDX(.MAGPARAM)

 . S MAGRY=1

 . Q

 ;

 I MAGPARAM("ACTION")="DELETE PROCEDURE" D  Q  ; Delete an entry and exit

 . D DPROCIDX(.MAGPARAM)

 . S MAGRY=1

 . Q

 ;

 I MAGPARAM("ACTION")="SET SITE STATUS" D  Q  ; Exit

 . S MAGRY=$$USITEST(.MAGPARAM)

 . Q

 ;

 I MAGPARAM("ACTION")="SET SPECIALTY STATUS" D  Q  ; Exit

 . S MAGRY=$$USPECST(.MAGPARAM)

 . Q

 ;

 I MAGPARAM("ACTION")="SET PROCEDURE STATUS" D  Q  ; Exit

 . S MAGRY=$$UPROCST(.MAGPARAM)

 . Q

 ;

 ; Add

 S MAGNFDA(2006.5843,"?+1,",.01)=MAGPARAM("READER")

 S MAGNFDA(2006.58431,"?+2,?+1,",.01)=MAGPARAM("ACQUISITION SITE")

 S MAGNFDA(2006.58431,"?+2,?+1,",.5)=MAGPARAM("ACQUISITION SITE STATUS")

 S MAGNFDA(2006.584311,"?+3,?+2,?+1,",.01)=MAGPARAM("SPECIALTY INDEX")

 S MAGNFDA(2006.584311,"?+3,?+2,?+1,",.5)=MAGPARAM("SPECIALTY INDEX STATUS")

 S MAGNFDA(2006.5843111,"?+4,?+3,?+2,?+1,",.01)=MAGPARAM("PROCEDURE INDEX")

 S MAGNFDA(2006.5843111,"?+4,?+3,?+2,?+1,",.5)=MAGPARAM("PROCEDURE INDEX STATUS")

 S MAGNFDA(2006.5843111,"?+4,?+3,?+2,?+1,",1)=MAGPARAM("PROCEDURE INDEX USER PREFERENCE")

 ;

 D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")

 ;

 I $D(MAGNXE("DIERR","E")) D  Q

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . S MAGRY="0^"_MAGRESA(1)

 . Q

 E  S MAGRY="1^OK"

 Q

 ;

DREADER(MAGPARAM) ; Delete a reader

 N MAGD0,DA,DIK

 S MAGD0=$O(^MAG(2006.5843,"B",MAGPARAM("READER"),""))

 S DA=MAGD0

 S DIK="^MAG(2006.5843,"

 D ^DIK

 Q

 ;

DACQSITE(MAGPARAM) ; Delete acquisition  site

 N MAGD0,MAGD1,DA,DIK

 S MAGD0=$O(^MAG(2006.5843,"B",MAGPARAM("READER"),""))

 S MAGD1=$O(^MAG(2006.5843,MAGD0,1,"B",MAGPARAM("ACQUISITION SITE"),""))

 S DA=MAGD1

 S DA(1)=MAGD0

 S DIK="^MAG(2006.5843,"_MAGD0_",1,"

 D ^DIK

 I $O(^MAG(2006.5843,MAGD0,1,"B",""))="" D DREADER(.MAGPARAM) Q  ; no more sites

 Q

 ;

DSPECIDX(MAGPARAM) ; Delete specialty

 N MAGD0,MAGD1,MAGD2,DA,DIK

 S MAGD0=$O(^MAG(2006.5843,"B",MAGPARAM("READER"),""))

 S MAGD1=$O(^MAG(2006.5843,MAGD0,1,"B",MAGPARAM("ACQUISITION SITE"),""))

 S MAGD2=$O(^MAG(2006.5843,MAGD0,1,MAGD1,1,"B",MAGPARAM("SPECIALTY INDEX"),""))

 S DA=MAGD2

 S DA(1)=MAGD1

 S DA(2)=MAGD0

 S DIK="^MAG(2006.5843,"_MAGD0_",1,"_MAGD1_",1,"

 D ^DIK

 I $O(^MAG(2006.5843,MAGD0,1,MAGD1,1,"B",""))="" D DACQSITE(.MAGPARAM) Q  ; no more specialties

 Q

 ;

DPROCIDX(MAGPARAM) ; Delete Procedure index from file #2006.5843

 N MAGD0,MAGD1,MAGD2,MAGD3,DA,DIK

 S MAGD0=$O(^MAG(2006.5843,"B",MAGPARAM("READER"),""))

 S MAGD1=$O(^MAG(2006.5843,MAGD0,1,"B",MAGPARAM("ACQUISITION SITE"),""))

 S MAGD2=$O(^MAG(2006.5843,MAGD0,1,MAGD1,1,"B",MAGPARAM("SPECIALTY INDEX"),""))

 S MAGD3=$O(^MAG(2006.5843,MAGD0,1,MAGD1,1,MAGD2,1,"B",MAGPARAM("PROCEDURE INDEX"),""))

 S DA=MAGD3

 S DA(1)=MAGD2

 S DA(2)=MAGD1

 S DA(3)=MAGD0

 S DIK="^MAG(2006.5843,"_MAGD0_",1,"_MAGD1_",1,"_MAGD2_",1,"

 D ^DIK

 I $O(^MAG(2006.5843,MAGD0,1,MAGD1,1,MAGD2,1,"B",""))="" D DSPECIDX(.MAGPARAM) Q  ; no more procedures

 Q

 ;

USITEST(MAGPARAM) ; Update Acquisition Site Status

 N MAGNFDA,MAGNIEN,MAGNXE,MAGRESA

 N MAGD0,MAGD1

 S MAGD0=$O(^MAG(2006.5843,"B",MAGPARAM("READER"),""))

 S MAGD1=$O(^MAG(2006.5843,MAGD0,1,"B",MAGPARAM("ACQUISITION SITE"),""))

 S MAGNFDA(2006.58431,MAGD1_","_MAGD0_",",.5)=MAGPARAM("ACQUISITION SITE STATUS")

 D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")

 I $D(MAGNXE("DIERR","E")) D  Q "0^"_MAGRESA(1)

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . Q

 E  Q "1^OK"

 Q

 ;

USPECST(MAGPARAM) ; Update Specialty Index Status

 N MAGNFDA,MAGNIEN,MAGNXE,MAGRESA

 N MAGD0,MAGD1,MAGD2

 S MAGD0=$O(^MAG(2006.5843,"B",MAGPARAM("READER"),""))

 S MAGD1=$O(^MAG(2006.5843,MAGD0,1,"B",MAGPARAM("ACQUISITION SITE"),""))

 S MAGD2=$O(^MAG(2006.5843,MAGD0,1,MAGD1,1,"B",MAGPARAM("SPECIALTY INDEX"),""))

 S MAGNFDA(2006.584311,MAGD2_","_MAGD1_","_MAGD0_",",.5)=MAGPARAM("SPECIALTY INDEX STATUS")

 D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")

 I $D(MAGNXE("DIERR","E")) D  Q "0^"_MAGRESA(1)

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . Q

 E  Q "1^OK"

 Q

 ;

UPROCST(MAGPARAM) ; Update Procedure Index Status

 N MAGNFDA,MAGNIEN,MAGNXE,MAGRESA

 N MAGD0,MAGD1,MAGD2,MAGD3

 S MAGD0=$O(^MAG(2006.5843,"B",MAGPARAM("READER"),""))

 S MAGD1=$O(^MAG(2006.5843,MAGD0,1,"B",MAGPARAM("ACQUISITION SITE"),""))

 S MAGD2=$O(^MAG(2006.5843,MAGD0,1,MAGD1,1,"B",MAGPARAM("SPECIALTY INDEX"),""))

 S MAGD3=$O(^MAG(2006.5843,MAGD0,1,MAGD1,1,MAGD2,1,"B",MAGPARAM("PROCEDURE INDEX"),""))

 S MAGNFDA(2006.5843111,MAGD3_","_MAGD2_","_MAGD1_","_MAGD0_",",.5)=MAGPARAM("PROCEDURE INDEX STATUS")

 D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")

 I $D(MAGNXE("DIERR","E")) D  Q "0^"_MAGRESA(1)

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . Q

 E  Q "1^OK"

 Q

 ;

 ;***** Set Time Out for an application

 ; RPC: MAG3 SET TIMEOUT

 ;

 ; Input Parameters

 ; ================

 ;   MAGAPP is "DISPLAY", "CAPTURE", "VISTARAD", "TELEREADER", or "TELEPATHOLOGY"

 ;   MAGTIME is time out value

 ;

 ; Return Values

 ; =============

 ; if error MAGRY = first "^" piece is zero if record is not found or 

 ;                   updating error

 ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 ;                              

TIMEOUT(MAGRY,MAGAPP,MAGTIME) ;RPC [MAG3 SET TIMEOUT]

 ; Set the timeout for the APP from IMAGING SITE PARAMETERS File

 ;  MAGAPP is either 'DISPLAY', 'CAPTURE','VISTARAD', or 'TELEREADER'

 ;

 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"

 ;

 N MAGNFDA,MAGNIEN,MAGNXE,MAGPLC,IEN,MAGFLD

 N MAGRESA

 ;

 S MAGRY=""

 S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))

 I 'MAGPLC S MAGRY="0^No record found" Q

 ;

 S IEN=MAGPLC_","

 I MAGAPP="DISPLAY" S MAGFLD=121

 I MAGAPP="CAPTURE" S MAGFLD=122

 I MAGAPP="VISTARAD" S MAGFLD=123

 I MAGAPP="TELEREADER" S MAGFLD=131

 I MAGAPP="TELEPATHOLOGY" S MAGFLD=135

 ;

 S MAGNFDA(2006.1,IEN,MAGFLD)=MAGTIME

 D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")

 I $D(MAGNXE("DIERR","E")) D  Q

 . D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 . S MAGRY="0^"_MAGRESA(1)

 . Q

 E  S MAGRY="1^"_MAGPLC

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MAGNTLRS   19933     printed  Apr 23, 2025@18:22                                                                                                                                                                                                      Page 2

MAGNTLRS  ;WOIFO/NST - TeleReader Configuration  ; 23 Apr 2012 2:30 PM

 +1       ;;3.0;IMAGING;**114,127,138**;Mar 19, 2002;Build 5380;Sep 03, 2013

 +2       ;; Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;; +---------------------------------------------------------------+

 +4       ;; | Property of the US Government.                                |

 +5       ;; | No permission to copy or redistribute this software is given. |

 +6       ;; | Use of unreleased versions of this software requires the user |

 +7       ;; | to execute a written test agreement with the VistA Imaging    |

 +8       ;; | Development Office of the Department of Veterans Affairs,     |

 +9       ;; | telephone (301) 734-0100.                                     |

 +10      ;; | The Food and Drug Administration classifies this software as  |

 +11      ;; | a medical device.  As such, it may not be changed in any way. |

 +12      ;; | Modifications to this software may result in an adulterated   |

 +13      ;; | medical device under 21CFR820, the use of which is considered |

 +14      ;; | to be a violation of US Federal Statutes.                     |

 +15      ;; +---------------------------------------------------------------+

 +16      ;;

 +17       QUIT 

 +18      ;

 +19      ;***** Add/Update/Delete a service in TELEREADER ACQUISITION SERVICE file (#2006.5841)

 +20      ; RPC: MAG3 TELEREADER ACQ SRVC SETUP

 +21      ;

 +22      ; Input Parameters

 +23      ; ================

 +24      ;   Delete action:

 +25      ;     MAGPARAM("ACTION")           = "DELETE"

 +26      ;     MAGPARAM("IEN")              = IEN of the record that will be deleted

 +27      ;   Add or Update action:

 +28      ;     MAGPARAM("ACTION")           = "ADD" or "UPDATE"

 +29      ;     MAGPARAM("NAME")             = A pointer to REQUEST SERVICES file (#123.5)

 +30      ;     MAGPARAM("PROCEDURE")        = A pointer to GMRC PROCEDURE file (#123.5)

 +31      ;     MAGPARAM("SPECIALTY INDEX")  = A pointer to the SPECIALTY file (#2005.84)

 +32      ;     MAGPARAM("PROCEDURE INDEX")  = A pointer to the PROCEDURE/EVENT file (#2005.85)

 +33      ;     MAGPARAM("ACQUISITION SITE") = A pointer to the INSTITUTION file (#4) 

 +34      ;     MAGPARAM("UNREAD LIST CREATION TRIGGER") = I/O/F

 +35      ;     MAGPARAM("TIU NOTE FILE")    = A pointer to TIU DOCUMENT file (#8925.1)

 +36      ; 

 +37      ; Return Values

 +38      ; =============

 +39      ; if error MAGRY = "0^Error"

 +40      ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 +41      ;                               or IEN of the added record

 +42      ;

UASRVC(MAGRY,MAGPARAM) ;RPC [MAG3 TELEREADER ACQ SRVC SETUP]

 +1       ;

 +2        NEW $ETRAP,$ESTACK

           SET $ETRAP="D ERR^MAGGTERR"

 +3       ;

 +4        NEW X,MAGNFDA,MAGNIEN,MAGNXE,IENS,MAGRESA

 +5        NEW DA,DIK

 +6       ;

 +7       ;^MAG(2006.5841,D0,0)=1=NAME, 2=PROCEDURE, 3=SPECIALTY INDEX, 4=PROCEDURE INDEX,

 +8       ;                     5=ACQUISITION SITE, 6=UNREAD LIST CREATION TRIGGER, 7=TIU NOTE FILE

 +9       ;

 +10      ; Delete an entry IEN and exit

           IF MAGPARAM("ACTION")="DELETE"

               Begin DoDot:1

 +11               SET DIK="^MAG(2006.5841,"

 +12               SET DA=MAGPARAM("IEN")

 +13               DO ^DIK

 +14               SET MAGRY=1

 +15               QUIT 

               End DoDot:1

               QUIT 

 +16      ;

 +17       SET MAGRY=""

 +18      ; Quit if a service already exists

           IF MAGPARAM("ACTION")="ADD"

               Begin DoDot:1

 +19               DO FIND^DIC(2006.5841,"","@;IX","PQX",MAGPARAM("NAME"),"1","B","","","X")

 +20               IF $DATA(X("DILIST","1",0))

                       SET MAGRY="0^Service already exists"

 +21               SET IENS="+1,"

               End DoDot:1

               if MAGRY'=""

                   QUIT 

 +22      IF '$TEST

               SET IENS=MAGPARAM("IEN")_","

               SET MAGNIEN(1)=MAGPARAM("IEN")

 +23      ;  

 +24       SET MAGNFDA(2006.5841,IENS,.01)=MAGPARAM("NAME")

 +25       SET MAGNFDA(2006.5841,IENS,1)=MAGPARAM("PROCEDURE")

 +26       SET MAGNFDA(2006.5841,IENS,2)=MAGPARAM("SPECIALTY INDEX")

 +27       SET MAGNFDA(2006.5841,IENS,3)=MAGPARAM("PROCEDURE INDEX")

 +28       SET MAGNFDA(2006.5841,IENS,4)=MAGPARAM("ACQUISITION SITE")

 +29       SET MAGNFDA(2006.5841,IENS,5)=MAGPARAM("UNREAD LIST CREATION TRIGGER")

 +30       SET MAGNFDA(2006.5841,IENS,6)=MAGPARAM("TIU NOTE FILE")

 +31      ;

 +32       DO UPDATE^DIE("SK","MAGNFDA","MAGNIEN","MAGNXE")

 +33      ;

 +34       IF $DATA(MAGNXE("DIERR","E"))

               Begin DoDot:1

 +35               DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 +36               SET MAGRY="0^"_MAGRESA(1)

 +37               QUIT 

               End DoDot:1

               QUIT 

 +38      IF '$TEST

               SET MAGRY="1^"_MAGNIEN(1)

 +39       QUIT 

 +40      ;

 +41      ;***** Add/Update/Delete a service in DICOM HEALTHCARE PROVIDER SERVICE file (#2006.5831)

 +42      ; RPC: MAG3 TELEREADER PDR SRVC SETUP

 +43      ;

 +44      ; Input Parameters

 +45      ; ================

 +46      ;   Delete action:

 +47      ;     MAGPARAM("ACTION")            = "DELETE"

 +48      ;     MAGPARAM("IEN")               = IEN of the record that will be deleted

 +49      ;   Add or Update action:

 +50      ;     MAGPARAM("ACTION")            = "ADD" or "UPDATE"

 +51      ;     MAGPARAM("REQUEST SERVICE") = A pointer to the "Request Services" file (#123.5)

 +52      ;     MAGPARAM("PROCEDURE")        = A pointer to GMRC PROCEDURE file (#123.3)

 +53      ;     MAGPARAM("SPECIALTY INDEX")  = A pointer to SPECIALTY file (#2005.84)

 +54      ;     MAGPARAM("PROCEDURE INDEX")  = A pointer to PROCEDURE/EVENT file (#2005.85)

 +55      ;     MAGPARAM("ACQUISITION SITE") = A pointer to INSTITUTION file (#4) 

 +56      ;     MAGPARAM("CPT CODE")         = A pointer to CPT file (#81)

 +57      ;     MAGPARAM("HL7 HLO SUBSCRIPTION LIST") = A pointer to HLO SUBSCRIPTION REGISTRY file (#779.4)

 +58      ;     MAGPARAM("CLINIC")            = "^" delimited string with clinics IENS in file (#44)

 +59      ; 

 +60      ; Return Values

 +61      ; =============

 +62      ; if error MAGRY = "0^Error"

 +63      ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 +64      ;                               or IEN of the added record

 +65      ;

UPSRVC(MAGRY,MAGPARAM) ;RPC [MAG3 TELEREADER PDR SRVC SETUP]

 +1       ;

 +2        NEW $ETRAP,$ESTACK

           SET $ETRAP="D ERR^MAGGTERR"

 +3       ;

 +4        NEW X,MAGNFDA,MAGNIEN,MAGNXE,IENS,IEN,MAGRESA

 +5        NEW DA,DIK

 +6       ;

 +7       ;^MAG(2006.5831,D0,0)=1=REQUEST SERVICE, 2=PROCEDURE, 3=SPECIALTY INDEX, 4=PROCEDURE INDEX

 +8       ;                     5=ACQUSITION SITE, 6=CPT CODE, 7=HL7 HLO SUBSCRIPTION LIST

 +9       ;

 +10      ; Delete an entry IEN and exit

           IF MAGPARAM("ACTION")="DELETE"

               Begin DoDot:1

 +11               SET DIK="^MAG(2006.5831,"

 +12               SET DA=MAGPARAM("IEN")

 +13               DO ^DIK

 +14               SET MAGRY=1

 +15               QUIT 

               End DoDot:1

               QUIT 

 +16      ;

 +17       SET MAGRY=""

 +18      ; Quit if a service,procedure already exists

           IF MAGPARAM("ACTION")="ADD"

               Begin DoDot:1

 +19               IF $$IREQUEST^MAGDHOW1(MAGPARAM("REQUEST SERVICE"),MAGPARAM("PROCEDURE"))>0

                       SET MAGRY="0^Service/Procedure pair already exists."

                       QUIT 

 +20               SET IENS="+1,"

 +21               QUIT 

               End DoDot:1

               if MAGRY'=""

                   QUIT 

 +22      ; ACTION = UPDATE

          IF '$TEST

               SET IENS=MAGPARAM("IEN")_","

               SET MAGNIEN(1)=MAGPARAM("IEN")

 +23      ;  

 +24      ; REQUEST SERVICE

           SET MAGNFDA(2006.5831,IENS,.01)=MAGPARAM("REQUEST SERVICE")

 +25      ; PROCEDURE

           SET MAGNFDA(2006.5831,IENS,2)=MAGPARAM("PROCEDURE")

 +26      ; SPECIALTY INDEX

           SET MAGNFDA(2006.5831,IENS,3)=MAGPARAM("SPECIALTY INDEX")

 +27      ; PROCEDURE INDEX

           SET MAGNFDA(2006.5831,IENS,4)=MAGPARAM("PROCEDURE INDEX")

 +28      ; ACQUISITION SITE

           SET MAGNFDA(2006.5831,IENS,5)=MAGPARAM("ACQUISITION SITE")

 +29      ; CPT CODE

           SET MAGNFDA(2006.5831,IENS,6)=MAGPARAM("CPT CODE")

 +30      ; HL7 HLO SUBSCRIPTION LIST

           SET MAGNFDA(2006.5831,IENS,7)=MAGPARAM("HL7 HLO SUBSCRIPTION LIST")

 +31      ;

 +32       DO UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")

 +33      ;

 +34       IF $DATA(MAGNXE("DIERR","E"))

               Begin DoDot:1

 +35               DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")

 +36               SET MAGRY="0^"_MAGRESA(1)

 +37               QUIT 

               End DoDot:1

               QUIT 

 +38      ;

 +39       IF $DATA(MAGPARAM("CLINIC"))

               IF '$$UCLINIC^MAGNTLRS(.MAGRY,MAGPARAM("CLINIC"),MAGNIEN(1))

                   QUIT 

 +40      ;

 +41       SET MAGRY="1^"_MAGNIEN(1)

 +42       QUIT 

 +43      ; #######################

 +44      ; UCLINIC -  Update Clinic multiple field in file #2006.5831

 +45      ;

 +46      ; Returns 0 if failed

 +47      ;         1 success

 +48      ; Input parameters

 +49      ;   CLINS = "^" delimited string with clinics IENS

 +50      ;   IEN   = IEN in file #2006.5831

 +51      ;

 +52      ; Output parameters

 +53      ;   RES = "0^Error"

 +54      ;

UCLINIC(RES,CLINS,IEN) ; Update Clinic field in file #2006.58311  (old #2006.58314)

 +1        NEW CLIN,CLINA,OUT,MSG,I

 +2        NEW DA,DIK

 +3        NEW MAGNFDA,MAGNXE,MAGNIEN

 +4        SET RES=""

 +5        DO LIST^DIC(2006.58311,","_IEN_",","@;.01I","",,,,,,,"OUT","MSG")

 +6        IF $DATA(MSG("DIERR","E"))

               SET RES="0^Error updating CLINIC field"

               QUIT 0

 +7       ;

 +8       ; set the variables so we can perform deletion of multiple if needed

           SET DA(1)=IEN

 +9        SET DIK="^MAG(2006.5831,"_IEN_",1,"

 +10      ;

 +11       FOR I=1:1

               SET CLIN=$PIECE(CLINS,"^",I)

               if CLIN=""

                   QUIT 

               SET CLINA(CLIN)=""

 +12      ;

 +13      ; delete multiple if they are not present in CLINA (CLINS)

 +14       SET I=0

 +15       FOR 

               SET I=$ORDER(OUT("DILIST","ID",I))

               if 'I

                   QUIT 

               Begin DoDot:1

 +16               SET CLIN=OUT("DILIST","ID",I,".01")

 +17      ; The Clin ID exists in multiple. Delete from CLINA and continue

                   IF $DATA(CLINA(CLIN))

                       KILL CLINA(CLIN)

                       QUIT 

 +18               SET DA=OUT("DILIST","2",I)

 +19               DO ^DIK

 +20               QUIT 

               End DoDot:1

 +21      ;

 +22      ; insert the new multiples

 +23       SET CLIN=""

 +24       FOR 

               SET CLIN=$ORDER(CLINA(CLIN))

               if CLIN=""

                   QUIT 

               if RES'=""

                   QUIT 

               Begin DoDot:1

 +25               KILL MAGNFDA,MAGNXE,MAGNIEN

 +26               SET MAGNFDA(2006.58311,"+1,"_IEN_",",.01)=CLIN

 +27               DO UPDATE^DIE("","MAGNFDA","","MAGNXE")

 +28               IF $DATA(MAGNXE("DIERR","E"))

                       SET RES="0^Error inserting CLINIC field "

                       QUIT 

 +29               QUIT 

               End DoDot:1

 +30      ; return 

           QUIT $SELECT(RES="":1,1:0)

 +31      ;

 +32      ;***** Add/Update/Delete a site in TELEREADER ACQUISITION SITE file (#2006.5842)

 +33      ; RPC: MAG3 TELEREADER SITE SETUP

 +34      ;

 +35      ; Input Parameters

 +36      ; ================

 +37      ;   Delete action:

 +38      ;     MAGPARAM("ACTION")                  = "DELETE"

 +39      ;     MAGPARAM("IEN")                     = IEN of the record that will be deleted

 +40      ;   Add or Update action:

 +41      ;     MAGPARAM("ACTION")                  = "ADD" or "UPDATE"

 +42      ;     MAGPARAM("NAME")                    = A pointer to the INSTITUTION file (#4)

 +43      ;     MAGPARAM("PRIMARY SITE")            = A pointer to the INSTITUTION file (#4)

 +44      ;     MAGPARAM("STATUS")                  = 0 or 1 (Active or Inactive)

 +45      ;     MAGPARAM("LOCK TIMEOUT IN MINUTES") = value of field #3 of file (#2006.5842)

 +46      ;

 +47      ; Return Values

 +48      ; =============

 +49      ; if error MAGRY = "0^Error"

 +50      ; if success MAGRY = "1^IEN" - IEN of the record that is updated

 +51      ;                               or IEN of the added record

 +52      ;

USITE(MAGRY,MAGPARAM) ;RPC [MAG3 TELEREADER SITE SETUP]

 +1       ;

 +2        NEW $ETRAP,$ESTACK

           SET $ETRAP="D ERR^MAGGTERR"

 +3       ;

 +4        NEW X,MAGNFDA,MAGNIEN,MAGNXE,IENS,MAGRESA

 +5        NEW DA,DIK

 +6       ;

 +7       ;^MAG(2006.5842,D0,0)=1=NAME,2=PRIMARY SITE,3=STATUS,4=LOCK TIMEOUT IN MINUTES

 +8       ;

 +9       ; Delete an entry IEN and exit

           IF MAGPARAM("ACTION")="DELETE"

               Begin DoDot:1

 +10               SET DIK="^MAG(2006.5842,"

 +11               SET DA=MAGPARAM("IEN")

 +12               DO ^DIK

 +13               SET MAGRY=1

 +14               QUIT 

               End DoDot:1

               QUIT 

 +15      ;

 +16       SET MAGRY=""

 +17      ; Quit if a record already exists

           IF MAGPARAM("ACTION")="ADD"

               Begin DoDot:1

 +18               DO FIND^DIC(2006.5842,"","@;IX","PQX",MAGPARAM("NAME"),"1","B","","","X")

 +19               IF $DATA(X("DILIST","1",0))

                       SET MAGRY="0^Record already exists"

 +20               SET IENS="+1,"

               End DoDot:1

               if MAGRY'=""

                   QUIT 

 +21      IF '$TEST

               SET IENS=MAGPARAM("IEN")_","