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