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

ISIDICR1.m

Go to the documentation of this file.
  1. ISIDICR1 ; ISI/JHC - RPCs for Dictation ; 10/17/2022
  1. ;;1.1;ESL ISI IMAGING;**102,106,110**;Dec 21, 2022;Build 41
  1. ;; This routine is the property of ViTel Net, and should not be modified.
  1. ;; This software is a medical device and is subject to FDA regulation.
  1. ;; Modifications to this software may only be made under the terms of
  1. ;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
  1. ;; with any applicable provision in this part renders a device
  1. ;; adulterated under section 501(h) of the act. Such a device,
  1. ;; as well as any person responsible for the failure to comply,
  1. ;; is subject to regulatory action."
  1. ;
  1. Q
  1. ;
  1. GETDXCOD(MAGRY) ;[RPC: ISI GET RAD DX CODES]
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIDICR1"
  1. N CT,IEN,MAGLST,REPLY,X
  1. S DIQUIET=1 D DT^DICRW
  1. S (CT,IEN)=0,MAGLST="ISIGETDXCOD"
  1. K MAGRY S MAGRY=$NA(^TMP($J,MAGLST)) K @MAGRY ; assign MAGRY value
  1. S REPLY="0^0~Getting Rad Diag Codes"
  1. F S IEN=$O(^RA(78.3,IEN)) Q:'IEN S X=^(IEN,0) I $P(X,U,5)'="Y" D ; filter Inactives
  1. . S CT=CT+1,X=IEN_U_$P(X,U),@MAGRY@(CT)=X
  1. S REPLY="0~Diagnostic codes returned."
  1. S @MAGRY@(0)=CT-1_U_REPLY
  1. Q
  1. ;
  1. ; RPC: ISIJ GET RAD TECHS
  1. ;
  1. RADLST(RESULTS) ; Returns list of all Rad Techs at logon Division
  1. ; RESULTS results returned here
  1. ; array:
  1. ; 1st entry = # lines below ^ code ~ message; code 0=normal result; 4=error
  1. ; 2:n entries = IEN ^ Tech Name --> from file 200
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIDICR1"
  1. N I,DIVNAME,MAGMSG,MAGTMP,RADCLASS,TNAM,X
  1. S DT=$$DT^XLFDT ; Make sure that the actual date is there
  1. S MAGTMP=$NA(^TMP("ISIRSL",$J))
  1. K @MAGTMP,RESULTS
  1. ;
  1. S DIVNAME=$$GET1^DIQ(4,DUZ(2)_",",.01,"E",,"MAGMSG") ; used for file #200 DIVISION index search
  1. S RADCLASS="T" ; Technologist
  1. ;
  1. S X="I $$SCRUSR^ISIDICR1(Y,RADCLASS)" ; Screening code
  1. D LIST^DIC(200,,"@;.01","P",,,DIVNAME,"AH",X,,MAGTMP,"MAGMSG") ; ICR # 10060 "AH"=DIVISION index
  1. S X=$G(@MAGTMP@("DILIST",0))
  1. I X'>0 S RESULTS(0)="0^4~No Technologists found at logon Site."
  1. E D
  1. . S I=0
  1. . F S I=$O(@MAGTMP@("DILIST",I)) Q:'I D
  1. . . S X=@MAGTMP@("DILIST",I,0)
  1. . . S TNAM($P(X,U,2))=X ; alphabetic ordering
  1. . S TNAM="",RESULTS(0)=0
  1. . F S TNAM=$O(TNAM(TNAM)) Q:TNAM="" D
  1. . . S RESULTS(0)=RESULTS(0)+1
  1. . . S RESULTS(RESULTS(0))=TNAM(TNAM)
  1. . S RESULTS(0)=RESULTS(0)_U_"0~Rad Techs list"
  1. . Q
  1. K @MAGTMP
  1. Q
  1. ;
  1. SCRUSR(IEN,RADCLASS) ; Screen logic function
  1. ; IEN -- entry in the NEW PERSON file (#200)
  1. ; Return Values:
  1. ; 0 Skip the record
  1. ; 1 Get the record
  1. N DISUSER,IEN1,MAGMSG,OK,SS,TMP,TERMDT
  1. ; Radiology classification matches input RADCLASS
  1. S (IEN1,OK)=0
  1. F S IEN1=$O(^VA(200,IEN,"RAC",IEN1)) Q:'IEN1 D Q:OK
  1. . I RADCLASS[$P(^VA(200,IEN,"RAC",IEN1,0),U) S OK=1
  1. Q:'OK 0
  1. ; Verify this person allowed at the logon Site DUZ(2)
  1. D GETS^DIQ(200,IEN,"16*","I","TMP","MAGMSG") ; ICR # 10060
  1. S OK=0 S SS="" F S SS=$O(TMP(200.02,SS)) Q:SS="" I $G(TMP(200.02,SS,.01,"I"))=DUZ(2) S OK=1 Q
  1. I 'OK Q 0
  1. ; Verify the termination date
  1. S TERMDT=$$GET1^DIQ(200,IEN_",",9.2,"I",,"MAGMSG") ; ICR # 10060
  1. I TERMDT>0 Q:TERMDT'>DT 0
  1. ; Verify the Active status
  1. S DISUSER=$$GET1^DIQ(200,IEN_",",7,"I",,"MAGMSG") ; ICR # 10060
  1. I DISUSER>0 Q 0
  1. Q OK
  1. ;
  1. ;
  1. ; RPC: ISIJ RAD EXAM UPDATE
  1. ;
  1. UPDEXAM(MAGRY,PARAMS) ; Update exam record
  1. ; Input PARAMS:
  1. ; TX_CODE ^ Case ID | Tech-1 ^ Tech-2 ^ Tech_Comment (* Note pipe-delimiter)
  1. ; TX_CODE = 1 --> update Tech & Tech Comment
  1. ; Case ID: RADFN^RADTI^RACNI^RARPT
  1. ; Tech-1 - IEN for the Technologist, or nil--> at least one tech must be passed in
  1. ; Tech-2 - IEN for the Technologist, or nil
  1. ; Tech_Comment - entered text, or nil
  1. ; Return in @maggry:
  1. ; Code ~ Reply display text
  1. ; Reply Code-enumerated values:
  1. ; 0 - Normal result
  1. ; 4 - Error result; display Reply text in error message box
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIDICR1"
  1. N CASEID,CMT,I,ICNT,IENS,IENS7003,MAGLST,PIPE,RADFN,RADTI,RACNI,RAFDA,REPLY,TECHS,X
  1. S DT=$$DT^XLFDT
  1. N DIQUIET S DIQUIET=1 D DT^DICRW
  1. S MAGLST="ISIJRPC" S MAGRY=$NA(^TMP($J,MAGLST)) K @MAGRY
  1. ;
  1. S PIPE="|"
  1. S REPLY=""
  1. S X=$P(PARAMS,PIPE)
  1. S TXID=+X,RADFN=+$P(X,U,2),RADTI=$P(X,U,3),RACNI=+$P(X,U,4)
  1. I RADFN,RADTI,RACNI,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; ICR 65
  1. E S REPLY="4~Invalid Request; no Exam found for input data. ("_PARAMS_") errcode*30a" G UPDEXAMZ
  1. S CASEID=$P(X,U,2,5)
  1. I TXID=1
  1. E S REPLY="4~Invalid Request; unrecognized input txid. ("_PARAMS_") errcode*30b" G UPDEXAMZ
  1. S X=$P(PARAMS,PIPE,2)
  1. S CMT=$P(X,U,3,99)
  1. F I=1,2 D
  1. . S T=$P(X,U,I)
  1. . I T?1.N,+T S TECHS(T)=""
  1. I $D(TECHS)
  1. E S REPLY="4~Invalid Request; must enter TECHNOLOGIST. ("_PARAMS_") errcode*30c" G UPDEXAMZ
  1. ; validate Tech(s)
  1. S T=0
  1. F I=1:1 S T=$O(TECHS(T)) Q:'T D I REPLY]"" G UPDEXAMZ
  1. . I $$SCRUSR^ISIDICR1(T,"T")
  1. . E S REPLY="4~Invalid Request; must enter TECHNOLOGIST. ("_PARAMS_") errcode*30d"
  1. ; file the data
  1. S IENS7003=$$EXAMIENS^RAMAGU04(CASEID)
  1. K RAFDA
  1. S T=0
  1. F ICNT=1:1 S T=$O(TECHS(T)) Q:'T D ; update TECH field
  1. . S IENS="+"_ICNT_","_IENS7003
  1. . S RAFDA(70.12,IENS,.01)=T
  1. D UPDATE^DIE("","RAFDA",,"RAMSG")
  1. I $G(DIERR) S REPLY="4~Error updating Technologist. errcode*30e" G UPDEXAMZ
  1. S IENS="+1,"_IENS7003
  1. K RAFDA
  1. D NOW^%DTC
  1. S RAFDA(70.07,IENS,.01)=$E(%,1,12) ; update Log fields: D/T, Activity code, User, & Comments (if any)
  1. S RAFDA(70.07,IENS,2)="C"
  1. S RAFDA(70.07,IENS,3)=DUZ
  1. I CMT]"" S RAFDA(70.07,IENS,4)=CMT
  1. D UPDATE^DIE("","RAFDA",,"RAMSG")
  1. I $G(DIERR) S REPLY="4~Error updating Log file. errcode*30e" G UPDEXAMZ
  1. S REPLY="0~Exam record updated"
  1. ;
  1. UPDEXAMZ ;
  1. S @MAGRY@(0)=REPLY
  1. Q
  1. ;
  1. ERR ;
  1. S @MAGRY@(0)="0^4~ERROR "_$$EC^%ZOSV
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. ;
  1. END ;