MAGVIM08 ;;WOIFO/NST,DAC,JSL - Imaging RPCs for Importer II/III ; 10 Oct 2020 10:01 AM
;;3.0;IMAGING;**118,185,301**;Mar 19, 2002;Build 3;OCT 10, 2020
;; 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
;
;***** Return number of records in MAG WORK ITEM file (#2006.941)
; by TYPE, SUBTYPE, and STATUS
;
; RPC:MAGV WORK ITEMS COUNT
;
; Input Parameters
; ================
; TYPE = External value of TYPE field (#2006.941,1)
; [SUBTYPE] = External value of SUBTYPE field (#2006.941,2)
; [STATUS] = External value of STATUS field (#2006.941,3)
;
; Return Values
; =============
; if error MAGRY(0) = Error number `` Error message
; if success MAGRY(0) = 0` Number of records
; MAGRY(1) = "SUBTYPE`STATUS`COUNT"
; MAGRY(1..n) = SUBTYPE ` STATUS ` COUNT
;
CNTWI(MAGRY,TYPE,SUBTYPE,STATUS) ; RPC [MAGV WORK ITEMS COUNT]
N SSEP,MAGRESA,MAGNXE,I,OUT,TOTAL,TYPEIEN,VSUB,VSTAT
S SSEP=$$STATSEP^MAGVIM01
I $G(TYPE)="" S MAGRY(0)=-1_SSEP_"No type provided" Q
S SUBTYPE=$G(SUBTYPE)
S STATUS=$G(STATUS)
;
S TYPEIEN=$$FIND1^DIC(2006.9412,"","BX",TYPE,"","","MAGNXE") ; Find the IEN for TYPE
I $D(MAGNXE("DIERR")) D Q
. D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
. S MAGRY(0)=-1_SSEP_MAGRESA(1)
. Q
;
I TYPEIEN'>0 S MAGRY(0)=-2_SSEP_"Type is not found" Q
;
D FIND^DIC(2006.941,"","@;2;3","QX",TYPEIEN,"","T","","","OUT","MAGNXE")
I $D(MAGNXE("DIERR")) D Q
. D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
. S MAGRY(0)=-3_SSEP_MAGRESA(1) Q ; Error getting the list
. Q
; Output the result
;
S I=0
F S I=$O(OUT("DILIST","ID",I)) Q:I'>0 D
. S VSUB=OUT("DILIST","ID",I,2)
. I (SUBTYPE'=""),(VSUB'=SUBTYPE) Q
. S VSTAT=OUT("DILIST","ID",I,3)
. I (STATUS'=""),(VSTAT'=STATUS) Q
. S TOTAL(VSUB,VSTAT)=$G(TOTAL(VSUB,VSTAT))+1
. Q
;
D OUTRES(.MAGRY,.TOTAL) ; Output the totals
Q
;
OUTRES(MAGRY,TOTAL) ; Output the final result by SUBTYPE and STATUS
; TOTAL - Input totals
; TOTAL("DirectImport","New")=3
; .....
; MAGRY - Output array
; MAGRY(0)=0`Total pairs (SUBTYPE,STATUS)
; MAGRY(1)="SUBTYPE`STATUS`COUNT"
N SSEP,CNT,SUBVAL,STATVAL
S SSEP=$$STATSEP^MAGVIM01
K MAGRY
S MAGRY(1)="SUBTYPE`STATUS`COUNT"
S CNT=1
S (SUBVAL,STATVAL)=""
F S SUBVAL=$O(TOTAL(SUBVAL)) Q:SUBVAL="" D
. F S STATVAL=$O(TOTAL(SUBVAL,STATVAL)) Q:STATVAL="" D
. . S CNT=CNT+1,MAGRY(CNT)=SUBVAL_SSEP_STATVAL_SSEP_TOTAL(SUBVAL,STATVAL)
. . Q
. Q
S MAGRY(0)=0_SSEP_(CNT-1)
Q
;
;***** Return RA Provider records in PERSON file (#200)
; by DUZ, NAME , and INITIAL
;
; RPC:MAGV GET RAD PROVIDER
;
; Input Parameters
; ================
; MAGIN = Input of RA provider (string)
; Return Values
; =============
; if error RESULTS(0) = Error number `` Error message
; if success MAGRY(0) = 0` Number of records
; MAGRY(1) = "PERSON IEN`FULL NAME`INITIAL"
; MAGRY(1..n) = DUZ ` NAME ` INIT
; For example: RESULTS(n)="123^IMAGPROVIDERONETHREEFOUR,ONETH^TST^^"
;
PROVLST(RESULTS,MAGIN) ; RPC [MAGV GET RAD PROVIDER]= "PSB GETPROVIDER"+ RA filter
N X,Y,MAGNOW,MAGNXE,MAGRESA,PRVAUTH,PRVIACT,PRVIEN,PRVTERM
K ^TMP("MAGV",$J)
S MAGNOW=$$NOW^XLFDT()
S MAGIN=$TR(MAGIN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S RESULTS(0)=1,RESULTS(1)="-1^No provider matching input."
D LIST^DIC(200,"","","P","","",MAGIN,"B","","","^TMP(""MAGV"",$J)","MAGNXE")
I $D(MAGNXE("DIERR")) D Q
. D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
. S RESULTS(0)="-3^"_MAGRESA(1) ; Error getting the list
. Q
S X=0
F S X=$O(^TMP("MAGV",$J,"DILIST",X)) Q:(X="") D
. S PRVIEN=$P(^TMP("MAGV",$J,"DILIST",X,0),U,1)
. I '$D(^XUSEC("PROVIDER",PRVIEN)) Q
. S PRVIACT=$$GET1^DIQ(200,PRVIEN_",",53.4,"I")
. Q:PRVIACT'=""&(+PRVIACT'>MAGNOW) ;if Inactive date and date is less than now Q
. S PRVTERM=$$GET1^DIQ(200,PRVIEN_",",9.2,"I")
. Q:PRVTERM'=""&(+PRVTERM'>MAGNOW) ;if termination date and date is less than now Q
. S PRVAUTH=$S($$ISIHS^MAGSPID():$D(^XUSEC("ORES",PRVIEN)),1:$$GET1^DIQ(200,PRVIEN_",",53.1,"I")) I PRVAUTH'=1 Q ;is AUTHORIZED TO WRITE MED ORDERS
. S Y=PRVIEN Q:'$$PROV^RABWORD() ;is RA provider
. I RESULTS(1)["-1" S RESULTS(0)=0
. S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=$P(^TMP("MAGV",$J,"DILIST",X,0),U,1,2)
. I RESULTS(0)>100 K RESULTS S RESULTS(0)=1,RESULTS(1)=-2
. Q
K ^TMP("MAGV",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM08 5430 printed Dec 13, 2024@02:09:55 Page 2
MAGVIM08 ;;WOIFO/NST,DAC,JSL - Imaging RPCs for Importer II/III ; 10 Oct 2020 10:01 AM
+1 ;;3.0;IMAGING;**118,185,301**;Mar 19, 2002;Build 3;OCT 10, 2020
+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 ;***** Return number of records in MAG WORK ITEM file (#2006.941)
+20 ; by TYPE, SUBTYPE, and STATUS
+21 ;
+22 ; RPC:MAGV WORK ITEMS COUNT
+23 ;
+24 ; Input Parameters
+25 ; ================
+26 ; TYPE = External value of TYPE field (#2006.941,1)
+27 ; [SUBTYPE] = External value of SUBTYPE field (#2006.941,2)
+28 ; [STATUS] = External value of STATUS field (#2006.941,3)
+29 ;
+30 ; Return Values
+31 ; =============
+32 ; if error MAGRY(0) = Error number `` Error message
+33 ; if success MAGRY(0) = 0` Number of records
+34 ; MAGRY(1) = "SUBTYPE`STATUS`COUNT"
+35 ; MAGRY(1..n) = SUBTYPE ` STATUS ` COUNT
+36 ;
CNTWI(MAGRY,TYPE,SUBTYPE,STATUS) ; RPC [MAGV WORK ITEMS COUNT]
+1 NEW SSEP,MAGRESA,MAGNXE,I,OUT,TOTAL,TYPEIEN,VSUB,VSTAT
+2 SET SSEP=$$STATSEP^MAGVIM01
+3 IF $GET(TYPE)=""
SET MAGRY(0)=-1_SSEP_"No type provided"
QUIT
+4 SET SUBTYPE=$GET(SUBTYPE)
+5 SET STATUS=$GET(STATUS)
+6 ;
+7 ; Find the IEN for TYPE
SET TYPEIEN=$$FIND1^DIC(2006.9412,"","BX",TYPE,"","","MAGNXE")
+8 IF $DATA(MAGNXE("DIERR"))
Begin DoDot:1
+9 DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
+10 SET MAGRY(0)=-1_SSEP_MAGRESA(1)
+11 QUIT
End DoDot:1
QUIT
+12 ;
+13 IF TYPEIEN'>0
SET MAGRY(0)=-2_SSEP_"Type is not found"
QUIT
+14 ;
+15 DO FIND^DIC(2006.941,"","@;2;3","QX",TYPEIEN,"","T","","","OUT","MAGNXE")
+16 IF $DATA(MAGNXE("DIERR"))
Begin DoDot:1
+17 DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
+18 ; Error getting the list
SET MAGRY(0)=-3_SSEP_MAGRESA(1)
QUIT
+19 QUIT
End DoDot:1
QUIT
+20 ; Output the result
+21 ;
+22 SET I=0
+23 FOR
SET I=$ORDER(OUT("DILIST","ID",I))
if I'>0
QUIT
Begin DoDot:1
+24 SET VSUB=OUT("DILIST","ID",I,2)
+25 IF (SUBTYPE'="")
IF (VSUB'=SUBTYPE)
QUIT
+26 SET VSTAT=OUT("DILIST","ID",I,3)
+27 IF (STATUS'="")
IF (VSTAT'=STATUS)
QUIT
+28 SET TOTAL(VSUB,VSTAT)=$GET(TOTAL(VSUB,VSTAT))+1
+29 QUIT
End DoDot:1
+30 ;
+31 ; Output the totals
DO OUTRES(.MAGRY,.TOTAL)
+32 QUIT
+33 ;
OUTRES(MAGRY,TOTAL) ; Output the final result by SUBTYPE and STATUS
+1 ; TOTAL - Input totals
+2 ; TOTAL("DirectImport","New")=3
+3 ; .....
+4 ; MAGRY - Output array
+5 ; MAGRY(0)=0`Total pairs (SUBTYPE,STATUS)
+6 ; MAGRY(1)="SUBTYPE`STATUS`COUNT"
+7 NEW SSEP,CNT,SUBVAL,STATVAL
+8 SET SSEP=$$STATSEP^MAGVIM01
+9 KILL MAGRY
+10 SET MAGRY(1)="SUBTYPE`STATUS`COUNT"
+11 SET CNT=1
+12 SET (SUBVAL,STATVAL)=""
+13 FOR
SET SUBVAL=$ORDER(TOTAL(SUBVAL))
if SUBVAL=""
QUIT
Begin DoDot:1
+14 FOR
SET STATVAL=$ORDER(TOTAL(SUBVAL,STATVAL))
if STATVAL=""
QUIT
Begin DoDot:2
+15 SET CNT=CNT+1
SET MAGRY(CNT)=SUBVAL_SSEP_STATVAL_SSEP_TOTAL(SUBVAL,STATVAL)
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 SET MAGRY(0)=0_SSEP_(CNT-1)
+19 QUIT
+20 ;
+21 ;***** Return RA Provider records in PERSON file (#200)
+22 ; by DUZ, NAME , and INITIAL
+23 ;
+24 ; RPC:MAGV GET RAD PROVIDER
+25 ;
+26 ; Input Parameters
+27 ; ================
+28 ; MAGIN = Input of RA provider (string)
+29 ; Return Values
+30 ; =============
+31 ; if error RESULTS(0) = Error number `` Error message
+32 ; if success MAGRY(0) = 0` Number of records
+33 ; MAGRY(1) = "PERSON IEN`FULL NAME`INITIAL"
+34 ; MAGRY(1..n) = DUZ ` NAME ` INIT
+35 ; For example: RESULTS(n)="123^IMAGPROVIDERONETHREEFOUR,ONETH^TST^^"
+36 ;
PROVLST(RESULTS,MAGIN) ; RPC [MAGV GET RAD PROVIDER]= "PSB GETPROVIDER"+ RA filter
+1 NEW X,Y,MAGNOW,MAGNXE,MAGRESA,PRVAUTH,PRVIACT,PRVIEN,PRVTERM
+2 KILL ^TMP("MAGV",$JOB)
+3 SET MAGNOW=$$NOW^XLFDT()
+4 SET MAGIN=$TRANSLATE(MAGIN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+5 SET RESULTS(0)=1
SET RESULTS(1)="-1^No provider matching input."
+6 DO LIST^DIC(200,"","","P","","",MAGIN,"B","","","^TMP(""MAGV"",$J)","MAGNXE")
+7 IF $DATA(MAGNXE("DIERR"))
Begin DoDot:1
+8 DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
+9 ; Error getting the list
SET RESULTS(0)="-3^"_MAGRESA(1)
+10 QUIT
End DoDot:1
QUIT
+11 SET X=0
+12 FOR
SET X=$ORDER(^TMP("MAGV",$JOB,"DILIST",X))
if (X="")
QUIT
Begin DoDot:1
+13 SET PRVIEN=$PIECE(^TMP("MAGV",$JOB,"DILIST",X,0),U,1)
+14 IF '$DATA(^XUSEC("PROVIDER",PRVIEN))
QUIT
+15 SET PRVIACT=$$GET1^DIQ(200,PRVIEN_",",53.4,"I")
+16 ;if Inactive date and date is less than now Q
if PRVIACT'=""&(+PRVIACT'>MAGNOW)
QUIT
+17 SET PRVTERM=$$GET1^DIQ(200,PRVIEN_",",9.2,"I")
+18 ;if termination date and date is less than now Q
if PRVTERM'=""&(+PRVTERM'>MAGNOW)
QUIT
+19 ;is AUTHORIZED TO WRITE MED ORDERS
SET PRVAUTH=$SELECT($$ISIHS^MAGSPID():$DATA(^XUSEC("ORES",PRVIEN)),1:$$GET1^DIQ(200,PRVIEN_",",53.1,"I"))
IF PRVAUTH'=1
QUIT
+20 ;is RA provider
SET Y=PRVIEN
if '$$PROV^RABWORD()
QUIT
+21 IF RESULTS(1)["-1"
SET RESULTS(0)=0
+22 SET RESULTS(0)=RESULTS(0)+1
SET RESULTS(RESULTS(0))=$PIECE(^TMP("MAGV",$JOB,"DILIST",X,0),U,1,2)
+23 IF RESULTS(0)>100
KILL RESULTS
SET RESULTS(0)=1
SET RESULTS(1)=-2
+24 QUIT
End DoDot:1
+25 KILL ^TMP("MAGV",$JOB)
+26 QUIT
