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

ECUMRPC.m

Go to the documentation of this file.
  1. ECUMRPC ;ALB/JAM;Event Capture Management Broker Utilities ;2/9/18 13:58
  1. ;;2.0;EVENT CAPTURE;**25,32,33,131,139**;8 May 96;Build 7
  1. ECUSR(RESULTS,ECARY) ;
  1. ;
  1. ;This broker entry point returns an array of users with access to a
  1. ;DSS unit in file 200.
  1. ; RPC: EC GETDSSUNITUSRS
  1. ;INPUTS ECARY - Contains the following subscripted elements
  1. ; UNT - DSS unit IEN
  1. ;
  1. ;OUTPUTS RESULTS - The array of users. Data pieces as follows:-
  1. ; PIECE - Description
  1. ; 1 NAME of user
  1. ; 2 DUZ or IEN of file 200
  1. ;
  1. N UNT,EDUZ,CNT
  1. D SETENV
  1. S UNT=$P(ECARY,U) Q:UNT=""
  1. K ^TMP($J,"ECUSR") S (EDUZ,CNT)=0
  1. F S EDUZ=$O(^VA(200,EDUZ)) Q:'EDUZ I $D(^VA(200,EDUZ,"EC",UNT,0)) D
  1. . S CNT=CNT+1,^TMP($J,"ECUSR",CNT)=$P(^VA(200,EDUZ,0),U)_U_EDUZ
  1. S RESULTS=$NA(^TMP($J,"ECUSR"))
  1. Q
  1. ;
  1. ECLOC(RESULTS) ;
  1. ;
  1. ;This broker entry point returns all active Event Capture locations
  1. ; RPC: EC GETECLOC
  1. ;
  1. ;OUTPUTS RESULTS - The array of active Event Capture locations.
  1. ; PIECE - Description
  1. ; 1 Location description
  1. ; 2 LOC IEN
  1. N LOC
  1. D SETENV
  1. K ^TMP($J,"ECLOC")
  1. D GETLOC^ECL(.LOC) M ^TMP($J,"ECLOC")=LOC
  1. S RESULTS=$NA(^TMP($J,"ECLOC"))
  1. Q
  1. ECSCN(RESULTS,ECARY) ;
  1. ;
  1. ;Broker call returns the entries from EC EVENT CODE SCREENS FILE #720.3
  1. ; RPC: GETECSCREEN
  1. ;INPUTS ECARY - Contains the following subscripted elements
  1. ; STAT - Active or inactive Event Code Screens
  1. ; A-ctive (default), I-nactive, B-oth
  1. ; LOCIEN - Location IEN (optional)
  1. ; DSSIEN - DSS IEN (optional)
  1. ;
  1. ;OUTPUTS RESULTS - Array of EC screens, contains
  1. ; 720.3 ien^location description^DSS Unit description^Category
  1. ; desription^Procedure 5 digit code and description
  1. ;
  1. N STAT,IEN,CNT,ACT,FL,V,EI,ECSCR,CLN,LOC,UNT,CAT,PX,NODE,LOCIEN,DSSIEN
  1. D SETENV K ^TMP($J,"ECSCN")
  1. S STAT=$P($G(ECARY,"A"),U),LOCIEN=$P($G(ECARY),U,2),FL="4,724,726"
  1. S V="LOC,UNT,CAT",(IEN,CNT)=0,DSSIEN=$P(ECARY,U,3)
  1. F S IEN=$O(^ECJ(IEN)) Q:'IEN S NODE=$G(^ECJ(IEN,0)) I NODE'="" D
  1. .S ACT=$P(NODE,U,2),ECSCR=$TR($P(NODE,U),"-;,","^^")
  1. .I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q
  1. .I LOCIEN'="",LOCIEN'=$P(ECSCR,U) Q
  1. .I DSSIEN'="",DSSIEN'=$P(ECSCR,U,2) Q
  1. .F EI=1:1:3 D
  1. ..S @$P(V,",",EI)=$$GET1^DIQ($P(FL,",",EI),$P(ECSCR,U,EI),.01,"E"),PX=""
  1. .I $P(ECSCR,U,5)["EC" D
  1. ..S PRO=$G(^EC(725,$P(ECSCR,U,4),0)),PX=$P(PRO,U,2)_" "_$P(PRO,U)
  1. .E S PRO=$$CPT^ICPTCOD($P(ECSCR,U,4)) S PX=$P(PRO,U,2)_" "_$P(PRO,U,3)
  1. .S CNT=CNT+1,^TMP($J,"ECSCN",CNT)=IEN_U_LOC_U_UNT_U_CAT_U_PX
  1. S RESULTS=$NA(^TMP($J,"ECSCN"))
  1. Q
  1. ECSDTLS(RESULTS,ECARY) ;
  1. ;
  1. ;Broker call returns details on an Event Code Screen from EC EVENT
  1. ;CODE SCREENS FILE #720.3
  1. ; RPC: GETECSDETAIL
  1. ;INPUTS ECARY - Contains the following data
  1. ; Event code screen IEN
  1. ;
  1. ;OUTPUTS RESULTS - Details of EC screen, contains
  1. ; 720.3 ien^event code screen key^synonym^volume^associated
  1. ; clinic^Procedure reason indicator^event code screen status
  1. ; flag (y-active,n-inactive)^Send To PCE
  1. ;
  1. N NODE,PRO,CLN,STAT,STR,SPCE
  1. Q:$G(ECARY)="" Q:'$D(^ECJ(ECARY,0))
  1. D SETENV
  1. S NODE=^ECJ(ECARY,0),PRO=$G(^ECJ(ECARY,"PRO")),SPCE=$P(NODE,"-",2)
  1. S SPCE=$P($G(^ECD(SPCE,0)),U,14),SPCE=$S(SPCE="A":1,1:0) ;139 Modified $S logic to set SPCE to 1 if "A" and 0 for all others. Value is used to determine if clinic is asked for as a choice
  1. S STAT=$S($P(NODE,U,2)="":"Y",1:"N")
  1. S:$P(PRO,U,4)'="" CLN=$$GET1^DIQ(44,$P(PRO,U,4),.01,"E")
  1. S STR=ECARY_U_$P(NODE,U)_U_$P(PRO,U,2,3)_U_$G(CLN)_U_$P(PRO,U,5)_U_STAT
  1. S RESULTS=STR_U_SPCE
  1. Q
  1. ;
  1. DSSECS(RESULTS,ECARY) ;
  1. ;
  1. ;Broker call returns a list of Event Code Screen from EC EVENT CODE
  1. ;SCREENS FILE #720.3 based on a DSS Unit
  1. ; RPC: EC GETDSSECS
  1. ;INPUTS ECARY - Contains the following data
  1. ; ECD - DSS Unit IEN
  1. ; ECL - Location
  1. ;
  1. ;OUTPUTS RESULTS - Data on EC screen, contains
  1. ; 720.3 ien^Procedure 5 digit code and description^Location^
  1. ; status(Y-active, N-inactive)^Category description^synonym
  1. ;
  1. N NODE,PRO,STAT,CNT,ECD,LOC,CAT,IEN,PX,PN,CATD,LOCDS,ECL,ECSYN
  1. S ECD=$P(ECARY,U),ECL=$P(ECARY,U,2) I ECD="",ECL="" Q
  1. D SETENV K ^TMP($J,"ECDSSECS")
  1. S (CNT,LOC)=0 I ECL'="" S LOC=ECL-1
  1. F S LOC=$O(^ECJ("AP",LOC)) Q:'LOC S CAT="" Q:ECL&(ECL'=LOC) D
  1. .I ECD'="" D:$D(^ECJ("AP",LOC,ECD)) GETSCN Q
  1. .S ECD=0 F S ECD=$O(^ECJ("AP",LOC,ECD)) Q:'ECD D GETSCN
  1. S RESULTS=$NA(^TMP($J,"ECDSSECS"))
  1. Q
  1. GETSCN F S CAT=$O(^ECJ("AP",LOC,ECD,CAT)) Q:CAT="" S PX="" D
  1. .I CAT,'$P(^ECD(ECD,0),U,11) Q ;131 Don't show screen if it has a category and the DSS Unit is set to "no categories"
  1. .F S PX=$O(^ECJ("AP",LOC,ECD,CAT,PX)) Q:PX="" S IEN=0 D
  1. ..F S IEN=$O(^ECJ("AP",LOC,ECD,CAT,PX,IEN)) Q:'IEN D
  1. ...S NODE=$G(^ECJ(IEN,0)) I NODE="" Q
  1. ...S PRO=$G(^ECJ(IEN,"PRO")),ECSYN=$P(PRO,U,2),PN=$P($P(PRO,U),";")
  1. ...I PN="" Q
  1. ...I $P(PRO,U)["EC" S PN=$G(^EC(725,PN,0)),PRO=$P(PN,U,2)_" "_$P(PN,U)
  1. ...E S PN=$$CPT^ICPTCOD(PN) S PRO=$P(PN,U,2)_" "_$P(PN,U,3)
  1. ...S STAT=$S($P(NODE,U,2)'="":"No",1:"Yes")
  1. ...S CATD=$S('CAT:"None",1:$P($G(^EC(726,CAT,0)),U))
  1. ...S LOCDS=$$GET1^DIQ(4,LOC,.01,"I"),CNT=CNT+1
  1. ...S ^TMP($J,"ECDSSECS",CNT)=IEN_U_PRO_U_LOCDS_U_STAT_U_CATD_U_ECSYN
  1. Q
  1. ;
  1. ECPXRS(RESULTS,ECARY) ;
  1. ;
  1. ;Broker call returns entries for Procedure reasons linked to EC screen.
  1. ; RPC: EC GETPXREASON
  1. ;INPUTS ECARY - Contains the following subscripted elements
  1. ; ECSCR - Event code screen ien (file #720.3)
  1. ;
  1. ;OUTPUTS RESULTS - Array of procedure reasons for EC screen
  1. ; Procedure reason^procedure reason ien #720.4^Event Code
  1. ; screens/procedure reason link ien #720.5
  1. ;
  1. N RSN,IEN,CNT,RIEN
  1. S ECSCR=$G(ECARY,"") I ECSCR="" Q
  1. D SETENV
  1. K ^TMP($J,"ECPXREAS") S (IEN,CNT)=0
  1. F S IEN=$O(^ECL("AD",ECSCR,IEN)) Q:'IEN D
  1. . S RSN=$G(^ECR(IEN,0)),RIEN=$O(^ECL("AD",ECSCR,IEN,0)) Q:'$P(RSN,U,2)
  1. . S CNT=CNT+1,^TMP($J,"ECPXREAS",CNT)=$P(RSN,U)_U_IEN_U_RIEN
  1. S RESULTS=$NA(^TMP($J,"ECPXREAS"))
  1. Q
  1. ;
  1. ECNATPX(RESULTS,ECARY) ;
  1. ;
  1. ;Broker call returns EC national & local Procedures from file #725.
  1. ; RPC: EC GETNATPX
  1. ;INPUTS ECARY - Contains the following subscripted elements
  1. ; ECPX - Procedures to output, L- local, N- National, B- Both
  1. ; STAT - Active or inactive EC Nat Codes
  1. ; A-ctive (default), I-nactive, B-oth
  1. ;
  1. ;OUTPUTS RESULTS - Array of EC local procedures
  1. ; ien #725^Procedure name^national number^inactive date^
  1. ; synonym^CPT ien^CPT code^CPT Short Name
  1. ;
  1. N STAT,IEN,STR,CNT,ACT,CPT,CPTDAT,ECPX
  1. D SETENV
  1. S ECPX=$P(ECARY,U),STAT=$P(ECARY,U,2)
  1. S:ECPX="" ECPX="L" S:STAT="" STAT="A"
  1. K ^TMP($J,"ECLOCPX")
  1. S IEN=$S(ECPX="L":90000,1:0),CNT=0
  1. F S IEN=$O(^EC(725,IEN)) Q:'IEN!((ECPX="N")&(IEN>90000)) D
  1. . S STR=$G(^EC(725,IEN,0)) I STR="" Q
  1. . S ACT=$P(STR,U,3),CPT=$P(STR,U,5)
  1. . I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q
  1. . S CPTDAT=$S(CPT="":"",1:$$CPT^ICPTCOD(CPT))
  1. . S CNT=CNT+1,^TMP($J,"ECLOCPX",CNT)=IEN_U_STR_U_$P(CPTDAT,U,2,3)
  1. S RESULTS=$NA(^TMP($J,"ECLOCPX"))
  1. Q
  1. SETENV ;set environment variables for RPC broker
  1. I '$G(DUZ) D
  1. . S DUZ=.5,DUZ(0)="@",U="^",DTIME=300
  1. . D NOW^%DTC S DT=X
  1. Q