VENPCCYR ; IHS/OIT/GIS - COMPONENT FRAMEWORK ; PROCESS ALL CF RPCs [ 03/05/09 4:39 PM ]
;;2.6;PCC+;**1,3,4**;APR 03, 2012;Build 24
;
;
;
DEMOPT(OUT,IN) ; EP - RPC: VEN CF GET DEMO PT DFN ; RETRUN THE DEMO PATIENT'S DFN
; RETRUN STRING: DFN;NAME;LOCAL CHART NUMBER
N HRN,DFN
S OUT=""
I $G(IN)="OB" S DFN=$O(^DPT("B","DEMO,OB PATIENT",0))
I $G(IN)="WC" S DFN=$O(^DPT("B","DEMO,WELL CHILD",0))
I $G(IN)="AM" S DFN=$O(^DPT("B","DEMO,ADULT MALE",0))
I $G(IN)="AF" S DFN=$O(^DPT("B","DEMO,ADULT FEMALE",0))
I 'DFN Q
S HRN=$P($G(^AUPNPAT(+DFN,41,DUZ(2),0)),U,2) I 'HRN Q
D PATIENT^VENPCCUR(.OUT,HRN)
Q
;
MOD(OUT,IN) ; EP - RPC: VEN CF TG STG GET MODULES
S OUT="BMX ADO SS^VEN CF LIST MODULES^^B~~~~"
Q
;
CMP(OUT,IN) ; EP - RPC: VEN CF TG STG SHOW COMPONENTS
S OUT="BMX ADO SS^VEN CF LIST COMPONENTS^^B~~~~"
Q
;
PRVLKUP(OUT,IN) ; EP - RPC: VEN CF LIST PROVIDERS
S OUT="BMX ADO SS^VEN CF CHECKIN PROVIDERS^^~~~~~APRV~BMXADOV2"
Q
;
TX(OUT,IN) ; EP - RPC: VEN CF GET TX STG
; IN = COMPONENT IEN;DFN;VISIT_IEN;MODULE_IEN;FORM_IEN;USER_IEN The VISIT IEN and DFN CAN BE SET TO 0 FOR DEMO MODE.
; OUT = Tx STRING
Q
;
SUBMIT(OUT,IN) ; EP - RPC: VEN CF SUBMIT TX STRING
; SUBMIT THE UPDATED STRING FROM THE TRANSACTION
; A VERIFICATION STRING WILL BE RETURNED
S OUT="",IN=$$STG(.IN)
I '$L($G(IN)) Q
Q
;
ABORT(OUT,IN) ; EP - RPC: VEN CR ABORT A TRANSACTION
; IN = TXIEN, OUT = TXIEN IF TX WAS SUCCESSFULLY DELETED
S OUT=""
N DA,DIK,DIC,DIE,DR,X,Y
S DA=+$G(IN) I 'DA Q
S DIK="^VEN(7.66,",OUT=DA
D ^DIK
Q
;
VALV(OUT,IN) ; EP - VEN CF LIST VISITS
; RETURN THE TX STRING FOR A LIST OF VALID VISITS
S OUT=""
I '$D(^DPT(+$G(IN),0)) Q
S OUT="BMX ADO SS^VEN CF VISIT LIST^^~"_$$FMADD^XLFDT(DT,-3)_"~~20~~VALV~VENPCCYV~"_IN
Q
;
NEWV(OUT,IN) ; EP - VEN CF CREATE TEST VISIT
; GIVEN SOURCE VISIT IEN AND NEW TIMESTAMP (VIEN;TS), CLONE A VISIT STUB AND PRIMARY V PRV & V POV ENTRIES
N TS,%DT,X,Y,Z,VIEN,VDT,NVIEN
S (VDT,OUT)=""
S VIEN=+$G(IN) I '$D(^AUPNVSIT(VIEN,0)) Q
S TS=$P($G(IN),";",2) I '$L(TS) Q
S X=TS,%DT="T" D ^%DT I Y=-1 Q
S VDT=Y
I 'VDT Q
D NEWV^VENPCCYV(VIEN,VDT,.NVIEN)
I NVIEN S OUT=NVIEN
Q
;
FLUSH(OUT,IN) ; EP - RPC: VEN CF FLUSH TX FILE
; IN = TXIEN;FILE
I '$L($G(IN)) S OUT="MISSING TRANSACTION ID" Q
N TXIEN,CIEN,XDA,X,Y,Z,%,GBL,VIEN,DFN,TXFILE,MODIEN,TFILE,OWNER
S OUT="INVALID TRANSACTION PARAMETER"
S TXIEN=+IN I 'TXIEN Q
S TXFILE=+$P(IN,";",2) I 'TXFILE S TXFILE=19707.66
S OWNER=$P(IN,"|",2)
S GBL=$G(^DIC(TXFILE,0,"GL")) I GBL="" Q
S %=$G(@(GBL_TXIEN_",0)")) I %="" Q
S DFN=+% I 'DFN Q
S MODIEN=$P(%,U,3) I 'MODIEN Q
S VIEN=$P(%,U,2) I 'VIEN Q
S TFILE=0
I $L($T(XDAF^VENPCCYP)) F S TFILE=$O(^VEN(7.69,MODIEN,3,"B",TFILE)) Q:'TFILE D XDAF^VENPCCYP(TFILE,TXIEN,VIEN,DFN,.XDA) ; LOOP THROUGH ALL THE LINKED FILES & MAKE XDA ARRAY
I '$O(XDA(0)) Q
S OUT=""
I $L($T(FLUSH^VENPCCYF)) D FLUSH^VENPCCYF(TXFILE,TXIEN,.XDA,.OUT,OWNER) ; FILE THE DATA, DELETE THE TX ROW
Q
;
MODEF(OUT,IN) ; EP - RPC: VEN CF GET MODULE DEFINITION ; RETRUN THE MODULE DEFINITION STRING (MODULE/FORM/COMPONENT)
Q
;
MODXML(OUT,IN) ; EP RPC: VEN CF GET MODULE DEF XML ; RETURN MODULE DEFINITION AS AN XML ARRAY
Q
;
STG(IN) ; EP - CONVERT AN ARRAY TO A STRING
N X,STG
I '$O(IN(0)) Q $G(IN)
S STG="",X=0
F S X=$O(IN(X)) Q:'X S STG=STG_IN(X)
Q STG
;
MAP(OUT,IN) ; EP - MAP GUI HEADERS AND COMPONENTS ; RPC = VEN CF GET HEADER MAP
; IN = FORM IEN
; OUT = HEADER NAME^COMPONENT NAME|COMPONENT IEN~COMPONENT NAME|COMPONENT IEN...
Q
;
TRIGGER(OUT,IN) ; EP - RPC: VEN CF TRIGGER
; IF A FIELD IN THE TX FILE IS A TRIGGER, SEND THAT QUAD HERE.
; RETURNS UPDATED QUAD STRING WITH ALL TRIGGERED ELEMENTS (INCLUDING TRIGGERED ELEMENTS IN OTHER COMPONENTS)
Q
;
CKTX(OUT,IN) ; EP - RPC: VEN CF CHECK TX ; CHECKS TO SEE IF THERE ALREADY IS AN ENTRY IN THE TX FILE FOR THIS PT
; INPUT: DFN|FORM_IEN|VISIT_IEN ; OUTUT = 1 OR 0
S OUT=0
I '$G(IN) Q
N FIEN,VIEN,DFN,TXIEN,V,F,P,PIEN,TXUID,DATA
S DFN=$P(IN,"|"),FIEN=$P(IN,"|",2),VIEN=$P(IN,"|",3),PIEN=$P(IN,"|",4)
I FIEN,VIEN
E Q
S %=VIEN_";"_FIEN
S TXIEN=$O(^VEN(7.66,"AU",%,0)) I 'TXIEN S OUT="0|" Q
S DATA=$G(^VEN(7.66,TXIEN,0)) I DATA="" K ^VEN(7.66,TXIEN),^VEN(7.66,"AU",%) Q "0|"
I $P(DATA,U,9) S OUT="2|" Q
S P=$P(DATA,U,7)
I P S P=P_"|"_$P($G(^VA(200,P,0)),U)
S OUT="1|"_P
Q
;
DELTX(OUT,IN) ; EP - RPC: VEN CF DELETE TX ; DELETES AN ABORTED TX
; INPUT: DFN|FORM_IEN|VISIT_IEN ; OUTUT = 1 OR 0
S OUT=0
I '$G(IN) Q
N DA,DIK,DIC,DIE,DR,X,Y,FIEN,VIEN,F,V,EDD,GBL,%
S DFN=$P(IN,"|"),FIEN=$P(IN,"|",2),VIEN=$P(IN,"|",3)
I DFN,FIEN,VIEN
E Q
TXCLEAN S DA=$O(^VEN(7.66,"AU",VIEN_";"_FIEN,0)) I 'DA Q
I $P($G(^VEN(7.66,DA,0)),U,9) D Q ; TX CLOSED. DONT DELETE. JUST CREATE A STUB
. S %=^VEN(7.66,DA,0)
. S EDD=$P($G(^VEN(7.66,DA,101)),U)
. S $P(%,U,6)="",$P(%,U,9)=1 ; CLEAR STUBS CREATED AND SET TX STATUS = "CLOSED"
. S GBL=$NA(^VEN(7.66))
. K @GBL@(DA)
. I EDD K @GBL@("AEW",EDD,DA) ; KILL OFF EVERYTHING EXCEPT 0 NODE & 0 NODE INDICES
. S @GBL@(DA,0)=%
. Q
S DIK="^VEN(7.66,"
D ^DIK
D ^XBFMK
Q
;
USER(OUT,IN) ; EP - RPC: VEN CF CURRENT USER
; IN = VIEN|FIEN|PRVIEN ; OUT = 1 IF REQUEST WAS SUCCESSFUL. IF NOT, OUT = 0
; IF PRVIEN IS DEFINED, TX IS ASSIGNED TO THAT PROVIDER. IF NOT, TX IS CLEARED OF ITS USER
S OUT=0
I $G(IN)="" Q
N VIEN,PRVIEN,FIEN,X,Y,Z,%,TXIEN
S VIEN=$P(IN,"|"),FIEN=$P(IN,"|",2),PRVIEN=$P(IN,"|",3)
I VIEN,FIEN
E Q
S %=VIEN_";"_FIEN,TXIEN=+$O(^VEN(7.66,"AU",%,0)) I '$D(^VEN(7.66,TXIEN,0)) Q
S OUT=1
S $P(^VEN(7.66,TXIEN,0),U,7)=$S(PRVIEN:PRVIEN,1:"")
Q
;
AV(OUT,IN) ; EP - RPC: VEN CF AV CODES
S OUT="",IN=""
Q
;
TVAL(OUT,IN) ; EP - RPC: VEN CF VALIDATION TEST
S OUT=""
I $G(IN)="" Q
N FILE,FLD,VAL,X,Y,Z,%,RESULT
S Z=$P(IN,"|",3) I Z'["~RPC" Q
S VAL=$P($P(IN,"|",2),"~") I VAL="" Q
S %=$P(IN,"|",4)
S FILE=$P(%,"~") I 'FILE Q
S FLD=$P(%,"~",2) I 'FLD Q
D CHK^DIE(FILE,FLD,"",VAL,.RESULT)
I RESULT'=U S OUT="OK" Q
S OUT=$G(^DD(FILE,FLD,3))
Q
;
VAL(OUT,IN) ; EP - RPC: VEN CF VALIDATION MSG
S OUT=""
I $G(IN)="" S OUT=0 Q
N X,Y,Z,%,PCE,MAX
S MAX=$L(IN,"|")
F PCE=1:1:MAX D
. S X=$P(IN,"|",PCE),Z=""
. D VAL1(.Z,X)
. I Z="" S Z=0
. I $L(OUT) S OUT=OUT_"|"
. S OUT=OUT_Z
. Q
I OUT="" S OUT=0
Q
;
VAL1(OUT,IN) ; NEW CODE SUPPORTS MULTIPLE VALIDATION MESSAGES
S OUT=""
I $G(IN)="" Q
N FILE,FLD,X,Y,Z,%,CIEN,FMT
S FILE=$P(IN,"~") I 'FILE Q
S FLD=$P(IN,"~",2) I 'FLD Q
S CIEN=$P(IN,"~",3) I 'CIEN Q
S FMT=$P($G(^VEN(7.68,CIEN,0)),U,4)
I FMT="F",$E(FILE,9) S FMT="S"
I FMT="S" D Q
. I $P($G(^DD(FILE,FLD,0)),U,2)["S" S OUT="Pick a code from the list" Q
. I $P($G(^DD(FILE,FLD,0)),U,2)["D",$G(^DD(FILE,FLD,3))="" S OUT="Enter a date (MM/DD/YYYY)" Q
. S OUT=$G(^DD(FILE,FLD,3))
. Q
I FMT="M" S OUT="Add (or append) a note here" Q
I FMT="C" S OUT="Select an item by checking it" Q
I FMT="P" S OUT="Enter status: 'P' (Positive) or 'N' (Negative). Optionally check prompted items. If a prompted item is checked, the status will automatically be set to 'P'." Q
I FMT="R" S OUT="Only one item can be selected from this list." Q
I FMT="W" S OUT="If an item has no current value, you may type a value next to the item." Q
I FMT="T"!(FMT="G") S OUT="This component can not be edited" Q
I FMT="F" D Q
. S %=$G(^VEN(7.68,CIEN,0)) I %="" S OUT=0 Q
. I $P(%,U,16) S OUT="This flowchart can not be edited" Q
. I $P(%,U,14) S OUT="You may add a new row to this flowchart. "
. E S OUT="You may not add a new row to this flowchart. "
. I $P(%,U,13) S OUT=OUT_"You may edit past flowchart entries." Q
. S OUT=OUT_"You may not edit past entries."
. Q
Q
;
CLTX(OUT,IN) ; EP - RPC: VEN CF TX SCRUB
; CLEAN OUT ENTIRE TX FILE
S OUT=0
N DA,X,DIK
S DIK="^VEN(7.66,",DA=0
F S DA=$O(^VEN(7.66,DA)) Q:'DA D ^DIK
S X=""
F S X=$O(^VEN(7.66,X)) Q:X="" I X'=0 K ^VEN(7.66,X)
D ^XBFMK
S OUT=1
Q
;
KBSEC(OUT,USER) ; EP - RPC: VEN KB PRIVILEGES
S OUT=0
I $G(USER)
E Q
I $D(^XUSEC("VENZKBEDIT",USER)) S OUT=1 Q
I $D(^XUSEC("VENZMGUI",USER)) S OUT=1 Q
Q
;
GUISEC(OUT,USER) ; EP - RPC:VEN WCM GUI PRIVILEGES
S OUT=0
I $G(USER)
E Q
I $D(^XUSEC("VENZDESKTOP",USER)) S OUT=1 Q
I $D(^XUSEC("VENZPRINT",USER)) S OUT=1 Q
I $D(^XUSEC("PROVIDER",USER)) S OUT=1 Q
I $D(^XUSEC("VENZMGUI",USER)) S OUT=1 Q
Q
;
IEN(X) ; EP - BMX CALL, GENERIC IEN
Q +$G(X)
;
VIEN(OUT,IN) ; EP - RPC: VEN EHR VISIT STUB ; CONVERT EHR ENCOUNTER STUB TO RPMS VISIT STUB ; IN = DFN|"HLIEN;VDT;A"|PRVIEN ; IF PERFECT MATCH '> 1 HR, OLD VIEN WILL BE RETURNED
S OUT=""
I $L($T(VSTR2VIS^BEHOENCX)),$L($G(IN))
E Q
N X,Y,Z,VSTG,DFN,HLIEN,VDT,PRVIEN,VIEN
S DFN=+IN I '$D(^DPT(DFN,0)) Q
S %=$P(IN,"|",2) I %="" Q
I '$D(^DIC(40.7,+%,0)) Q
I $P(%,";",3)'="A" Q
S VDT=$P(%,";",2) I (VDT\1)'?7N Q
S PRVIEN=$P(IN,"|",3) I PRVIEN,'$D(^VA(200,PRVIEN,0)) Q
S OUT=$$VSTR2VIS^BEHOENCX(DFN,%,1,PRVIEN)
Q
;
VENPCCYR ; IHS/OIT/GIS - COMPONENT FRAMEWORK ; PROCESS ALL CF RPCs [ 03/05/09 4:39 PM ]
+1 ;;2.6;PCC+;**1,3,4**;APR 03, 2012;Build 24
+2 ;
+3 ;
+4 ;
DEMOPT(OUT,IN) ; EP - RPC: VEN CF GET DEMO PT DFN ; RETRUN THE DEMO PATIENT'S DFN
+1 ; RETRUN STRING: DFN;NAME;LOCAL CHART NUMBER
+2 NEW HRN,DFN
+3 SET OUT=""
+4 IF $GET(IN)="OB"
SET DFN=$ORDER(^DPT("B","DEMO,OB PATIENT",0))
+5 IF $GET(IN)="WC"
SET DFN=$ORDER(^DPT("B","DEMO,WELL CHILD",0))
+6 IF $GET(IN)="AM"
SET DFN=$ORDER(^DPT("B","DEMO,ADULT MALE",0))
+7 IF $GET(IN)="AF"
SET DFN=$ORDER(^DPT("B","DEMO,ADULT FEMALE",0))
+8 IF 'DFN
QUIT
+9 SET HRN=$PIECE($GET(^AUPNPAT(+DFN,41,DUZ(2),0)),U,2)
IF 'HRN
QUIT
+10 DO PATIENT^VENPCCUR(.OUT,HRN)
+11 QUIT
+12 ;
MOD(OUT,IN) ; EP - RPC: VEN CF TG STG GET MODULES
+1 SET OUT="BMX ADO SS^VEN CF LIST MODULES^^B~~~~"
+2 QUIT
+3 ;
CMP(OUT,IN) ; EP - RPC: VEN CF TG STG SHOW COMPONENTS
+1 SET OUT="BMX ADO SS^VEN CF LIST COMPONENTS^^B~~~~"
+2 QUIT
+3 ;
PRVLKUP(OUT,IN) ; EP - RPC: VEN CF LIST PROVIDERS
+1 SET OUT="BMX ADO SS^VEN CF CHECKIN PROVIDERS^^~~~~~APRV~BMXADOV2"
+2 QUIT
+3 ;
TX(OUT,IN) ; EP - RPC: VEN CF GET TX STG
+1 ; IN = COMPONENT IEN;DFN;VISIT_IEN;MODULE_IEN;FORM_IEN;USER_IEN The VISIT IEN and DFN CAN BE SET TO 0 FOR DEMO MODE.
+2 ; OUT = Tx STRING
+3 QUIT
+4 ;
SUBMIT(OUT,IN) ; EP - RPC: VEN CF SUBMIT TX STRING
+1 ; SUBMIT THE UPDATED STRING FROM THE TRANSACTION
+2 ; A VERIFICATION STRING WILL BE RETURNED
+3 SET OUT=""
SET IN=$$STG(.IN)
+4 IF '$LENGTH($GET(IN))
QUIT
+5 QUIT
+6 ;
ABORT(OUT,IN) ; EP - RPC: VEN CR ABORT A TRANSACTION
+1 ; IN = TXIEN, OUT = TXIEN IF TX WAS SUCCESSFULLY DELETED
+2 SET OUT=""
+3 NEW DA,DIK,DIC,DIE,DR,X,Y
+4 SET DA=+$GET(IN)
IF 'DA
QUIT
+5 SET DIK="^VEN(7.66,"
SET OUT=DA
+6 DO ^DIK
+7 QUIT
+8 ;
VALV(OUT,IN) ; EP - VEN CF LIST VISITS
+1 ; RETURN THE TX STRING FOR A LIST OF VALID VISITS
+2 SET OUT=""
+3 IF '$DATA(^DPT(+$GET(IN),0))
QUIT
+4 SET OUT="BMX ADO SS^VEN CF VISIT LIST^^~"_$$FMADD^XLFDT(DT,-3)_"~~20~~VALV~VENPCCYV~"_IN
+5 QUIT
+6 ;
NEWV(OUT,IN) ; EP - VEN CF CREATE TEST VISIT
+1 ; GIVEN SOURCE VISIT IEN AND NEW TIMESTAMP (VIEN;TS), CLONE A VISIT STUB AND PRIMARY V PRV & V POV ENTRIES
+2 NEW TS,%DT,X,Y,Z,VIEN,VDT,NVIEN
+3 SET (VDT,OUT)=""
+4 SET VIEN=+$GET(IN)
IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT
+5 SET TS=$PIECE($GET(IN),";",2)
IF '$LENGTH(TS)
QUIT
+6 SET X=TS
SET %DT="T"
DO ^%DT
IF Y=-1
QUIT
+7 SET VDT=Y
+8 IF 'VDT
QUIT
+9 DO NEWV^VENPCCYV(VIEN,VDT,.NVIEN)
+10 IF NVIEN
SET OUT=NVIEN
+11 QUIT
+12 ;
FLUSH(OUT,IN) ; EP - RPC: VEN CF FLUSH TX FILE
+1 ; IN = TXIEN;FILE
+2 IF '$LENGTH($GET(IN))
SET OUT="MISSING TRANSACTION ID"
QUIT
+3 NEW TXIEN,CIEN,XDA,X,Y,Z,%,GBL,VIEN,DFN,TXFILE,MODIEN,TFILE,OWNER
+4 SET OUT="INVALID TRANSACTION PARAMETER"
+5 SET TXIEN=+IN
IF 'TXIEN
QUIT
+6 SET TXFILE=+$PIECE(IN,";",2)
IF 'TXFILE
SET TXFILE=19707.66
+7 SET OWNER=$PIECE(IN,"|",2)
+8 SET GBL=$GET(^DIC(TXFILE,0,"GL"))
IF GBL=""
QUIT
+9 SET %=$GET(@(GBL_TXIEN_",0)"))
IF %=""
QUIT
+10 SET DFN=+%
IF 'DFN
QUIT
+11 SET MODIEN=$PIECE(%,U,3)
IF 'MODIEN
QUIT
+12 SET VIEN=$PIECE(%,U,2)
IF 'VIEN
QUIT
+13 SET TFILE=0
+14 ; LOOP THROUGH ALL THE LINKED FILES & MAKE XDA ARRAY
IF $LENGTH($TEXT(XDAF^VENPCCYP))
FOR
SET TFILE=$ORDER(^VEN(7.69,MODIEN,3,"B",TFILE))
IF 'TFILE
QUIT
DO XDAF^VENPCCYP(TFILE,TXIEN,VIEN,DFN,.XDA)
+15 IF '$ORDER(XDA(0))
QUIT
+16 SET OUT=""
+17 ; FILE THE DATA, DELETE THE TX ROW
IF $LENGTH($TEXT(FLUSH^VENPCCYF))
DO FLUSH^VENPCCYF(TXFILE,TXIEN,.XDA,.OUT,OWNER)
+18 QUIT
+19 ;
MODEF(OUT,IN) ; EP - RPC: VEN CF GET MODULE DEFINITION ; RETRUN THE MODULE DEFINITION STRING (MODULE/FORM/COMPONENT)
+1 QUIT
+2 ;
MODXML(OUT,IN) ; EP RPC: VEN CF GET MODULE DEF XML ; RETURN MODULE DEFINITION AS AN XML ARRAY
+1 QUIT
+2 ;
STG(IN) ; EP - CONVERT AN ARRAY TO A STRING
+1 NEW X,STG
+2 IF '$ORDER(IN(0))
QUIT $GET(IN)
+3 SET STG=""
SET X=0
+4 FOR
SET X=$ORDER(IN(X))
IF 'X
QUIT
SET STG=STG_IN(X)
+5 QUIT STG
+6 ;
MAP(OUT,IN) ; EP - MAP GUI HEADERS AND COMPONENTS ; RPC = VEN CF GET HEADER MAP
+1 ; IN = FORM IEN
+2 ; OUT = HEADER NAME^COMPONENT NAME|COMPONENT IEN~COMPONENT NAME|COMPONENT IEN...
+3 QUIT
+4 ;
TRIGGER(OUT,IN) ; EP - RPC: VEN CF TRIGGER
+1 ; IF A FIELD IN THE TX FILE IS A TRIGGER, SEND THAT QUAD HERE.
+2 ; RETURNS UPDATED QUAD STRING WITH ALL TRIGGERED ELEMENTS (INCLUDING TRIGGERED ELEMENTS IN OTHER COMPONENTS)
+3 QUIT
+4 ;
CKTX(OUT,IN) ; EP - RPC: VEN CF CHECK TX ; CHECKS TO SEE IF THERE ALREADY IS AN ENTRY IN THE TX FILE FOR THIS PT
+1 ; INPUT: DFN|FORM_IEN|VISIT_IEN ; OUTUT = 1 OR 0
+2 SET OUT=0
+3 IF '$GET(IN)
QUIT
+4 NEW FIEN,VIEN,DFN,TXIEN,V,F,P,PIEN,TXUID,DATA
+5 SET DFN=$PIECE(IN,"|")
SET FIEN=$PIECE(IN,"|",2)
SET VIEN=$PIECE(IN,"|",3)
SET PIEN=$PIECE(IN,"|",4)
+6 IF FIEN
IF VIEN
+7 IF '$TEST
QUIT
+8 SET %=VIEN_";"_FIEN
+9 SET TXIEN=$ORDER(^VEN(7.66,"AU",%,0))
IF 'TXIEN
SET OUT="0|"
QUIT
+10 SET DATA=$GET(^VEN(7.66,TXIEN,0))
IF DATA=""
KILL ^VEN(7.66,TXIEN),^VEN(7.66,"AU",%)
QUIT "0|"
+11 IF $PIECE(DATA,U,9)
SET OUT="2|"
QUIT
+12 SET P=$PIECE(DATA,U,7)
+13 IF P
SET P=P_"|"_$PIECE($GET(^VA(200,P,0)),U)
+14 SET OUT="1|"_P
+15 QUIT
+16 ;
DELTX(OUT,IN) ; EP - RPC: VEN CF DELETE TX ; DELETES AN ABORTED TX
+1 ; INPUT: DFN|FORM_IEN|VISIT_IEN ; OUTUT = 1 OR 0
+2 SET OUT=0
+3 IF '$GET(IN)
QUIT
+4 NEW DA,DIK,DIC,DIE,DR,X,Y,FIEN,VIEN,F,V,EDD,GBL,%
+5 SET DFN=$PIECE(IN,"|")
SET FIEN=$PIECE(IN,"|",2)
SET VIEN=$PIECE(IN,"|",3)
+6 IF DFN
IF FIEN
IF VIEN
+7 IF '$TEST
QUIT
TXCLEAN SET DA=$ORDER(^VEN(7.66,"AU",VIEN_";"_FIEN,0))
IF 'DA
QUIT
+1 ; TX CLOSED. DONT DELETE. JUST CREATE A STUB
IF $PIECE($GET(^VEN(7.66,DA,0)),U,9)
Begin DoDot:1
+2 SET %=^VEN(7.66,DA,0)
+3 SET EDD=$PIECE($GET(^VEN(7.66,DA,101)),U)
+4 ; CLEAR STUBS CREATED AND SET TX STATUS = "CLOSED"
SET $PIECE(%,U,6)=""
SET $PIECE(%,U,9)=1
+5 SET GBL=$NAME(^VEN(7.66))
+6 KILL @GBL@(DA)
+7 ; KILL OFF EVERYTHING EXCEPT 0 NODE & 0 NODE INDICES
IF EDD
KILL @GBL@("AEW",EDD,DA)
+8 SET @GBL@(DA,0)=%
+9 QUIT
End DoDot:1
QUIT
+10 SET DIK="^VEN(7.66,"
+11 DO ^DIK
+12 DO ^XBFMK
+13 QUIT
+14 ;
USER(OUT,IN) ; EP - RPC: VEN CF CURRENT USER
+1 ; IN = VIEN|FIEN|PRVIEN ; OUT = 1 IF REQUEST WAS SUCCESSFUL. IF NOT, OUT = 0
+2 ; IF PRVIEN IS DEFINED, TX IS ASSIGNED TO THAT PROVIDER. IF NOT, TX IS CLEARED OF ITS USER
+3 SET OUT=0
+4 IF $GET(IN)=""
QUIT
+5 NEW VIEN,PRVIEN,FIEN,X,Y,Z,%,TXIEN
+6 SET VIEN=$PIECE(IN,"|")
SET FIEN=$PIECE(IN,"|",2)
SET PRVIEN=$PIECE(IN,"|",3)
+7 IF VIEN
IF FIEN
+8 IF '$TEST
QUIT
+9 SET %=VIEN_";"_FIEN
SET TXIEN=+$ORDER(^VEN(7.66,"AU",%,0))
IF '$DATA(^VEN(7.66,TXIEN,0))
QUIT
+10 SET OUT=1
+11 SET $PIECE(^VEN(7.66,TXIEN,0),U,7)=$SELECT(PRVIEN:PRVIEN,1:"")
+12 QUIT
+13 ;
AV(OUT,IN) ; EP - RPC: VEN CF AV CODES
+1 SET OUT=""
SET IN=""
+2 QUIT
+3 ;
TVAL(OUT,IN) ; EP - RPC: VEN CF VALIDATION TEST
+1 SET OUT=""
+2 IF $GET(IN)=""
QUIT
+3 NEW FILE,FLD,VAL,X,Y,Z,%,RESULT
+4 SET Z=$PIECE(IN,"|",3)
IF Z'["~RPC"
QUIT
+5 SET VAL=$PIECE($PIECE(IN,"|",2),"~")
IF VAL=""
QUIT
+6 SET %=$PIECE(IN,"|",4)
+7 SET FILE=$PIECE(%,"~")
IF 'FILE
QUIT
+8 SET FLD=$PIECE(%,"~",2)
IF 'FLD
QUIT
+9 DO CHK^DIE(FILE,FLD,"",VAL,.RESULT)
+10 IF RESULT'=U
SET OUT="OK"
QUIT
+11 SET OUT=$GET(^DD(FILE,FLD,3))
+12 QUIT
+13 ;
VAL(OUT,IN) ; EP - RPC: VEN CF VALIDATION MSG
+1 SET OUT=""
+2 IF $GET(IN)=""
SET OUT=0
QUIT
+3 NEW X,Y,Z,%,PCE,MAX
+4 SET MAX=$LENGTH(IN,"|")
+5 FOR PCE=1:1:MAX
Begin DoDot:1
+6 SET X=$PIECE(IN,"|",PCE)
SET Z=""
+7 DO VAL1(.Z,X)
+8 IF Z=""
SET Z=0
+9 IF $LENGTH(OUT)
SET OUT=OUT_"|"
+10 SET OUT=OUT_Z
+11 QUIT
End DoDot:1
+12 IF OUT=""
SET OUT=0
+13 QUIT
+14 ;
VAL1(OUT,IN) ; NEW CODE SUPPORTS MULTIPLE VALIDATION MESSAGES
+1 SET OUT=""
+2 IF $GET(IN)=""
QUIT
+3 NEW FILE,FLD,X,Y,Z,%,CIEN,FMT
+4 SET FILE=$PIECE(IN,"~")
IF 'FILE
QUIT
+5 SET FLD=$PIECE(IN,"~",2)
IF 'FLD
QUIT
+6 SET CIEN=$PIECE(IN,"~",3)
IF 'CIEN
QUIT
+7 SET FMT=$PIECE($GET(^VEN(7.68,CIEN,0)),U,4)
+8 IF FMT="F"
IF $EXTRACT(FILE,9)
SET FMT="S"
+9 IF FMT="S"
Begin DoDot:1
+10 IF $PIECE($GET(^DD(FILE,FLD,0)),U,2)["S"
SET OUT="Pick a code from the list"
QUIT
+11 IF $PIECE($GET(^DD(FILE,FLD,0)),U,2)["D"
IF $GET(^DD(FILE,FLD,3))=""
SET OUT="Enter a date (MM/DD/YYYY)"
QUIT
+12 SET OUT=$GET(^DD(FILE,FLD,3))
+13 QUIT
End DoDot:1
QUIT
+14 IF FMT="M"
SET OUT="Add (or append) a note here"
QUIT
+15 IF FMT="C"
SET OUT="Select an item by checking it"
QUIT
+16 IF FMT="P"
SET OUT="Enter status: 'P' (Positive) or 'N' (Negative). Optionally check prompted items. If a prompted item is checked, the status will automatically be set to 'P'."
QUIT
+17 IF FMT="R"
SET OUT="Only one item can be selected from this list."
QUIT
+18 IF FMT="W"
SET OUT="If an item has no current value, you may type a value next to the item."
QUIT
+19 IF FMT="T"!(FMT="G")
SET OUT="This component can not be edited"
QUIT
+20 IF FMT="F"
Begin DoDot:1
+21 SET %=$GET(^VEN(7.68,CIEN,0))
IF %=""
SET OUT=0
QUIT
+22 IF $PIECE(%,U,16)
SET OUT="This flowchart can not be edited"
QUIT
+23 IF $PIECE(%,U,14)
SET OUT="You may add a new row to this flowchart. "
+24 IF '$TEST
SET OUT="You may not add a new row to this flowchart. "
+25 IF $PIECE(%,U,13)
SET OUT=OUT_"You may edit past flowchart entries."
QUIT
+26 SET OUT=OUT_"You may not edit past entries."
+27 QUIT
End DoDot:1
QUIT
+28 QUIT
+29 ;
CLTX(OUT,IN) ; EP - RPC: VEN CF TX SCRUB
+1 ; CLEAN OUT ENTIRE TX FILE
+2 SET OUT=0
+3 NEW DA,X,DIK
+4 SET DIK="^VEN(7.66,"
SET DA=0
+5 FOR
SET DA=$ORDER(^VEN(7.66,DA))
IF 'DA
QUIT
DO ^DIK
+6 SET X=""
+7 FOR
SET X=$ORDER(^VEN(7.66,X))
IF X=""
QUIT
IF X'=0
KILL ^VEN(7.66,X)
+8 DO ^XBFMK
+9 SET OUT=1
+10 QUIT
+11 ;
KBSEC(OUT,USER) ; EP - RPC: VEN KB PRIVILEGES
+1 SET OUT=0
+2 IF $GET(USER)
+3 IF '$TEST
QUIT
+4 IF $DATA(^XUSEC("VENZKBEDIT",USER))
SET OUT=1
QUIT
+5 IF $DATA(^XUSEC("VENZMGUI",USER))
SET OUT=1
QUIT
+6 QUIT
+7 ;
GUISEC(OUT,USER) ; EP - RPC:VEN WCM GUI PRIVILEGES
+1 SET OUT=0
+2 IF $GET(USER)
+3 IF '$TEST
QUIT
+4 IF $DATA(^XUSEC("VENZDESKTOP",USER))
SET OUT=1
QUIT
+5 IF $DATA(^XUSEC("VENZPRINT",USER))
SET OUT=1
QUIT
+6 IF $DATA(^XUSEC("PROVIDER",USER))
SET OUT=1
QUIT
+7 IF $DATA(^XUSEC("VENZMGUI",USER))
SET OUT=1
QUIT
+8 QUIT
+9 ;
IEN(X) ; EP - BMX CALL, GENERIC IEN
+1 QUIT +$GET(X)
+2 ;
VIEN(OUT,IN) ; EP - RPC: VEN EHR VISIT STUB ; CONVERT EHR ENCOUNTER STUB TO RPMS VISIT STUB ; IN = DFN|"HLIEN;VDT;A"|PRVIEN ; IF PERFECT MATCH '> 1 HR, OLD VIEN WILL BE RETURNED
+1 SET OUT=""
+2 IF $LENGTH($TEXT(VSTR2VIS^BEHOENCX))
IF $LENGTH($GET(IN))
+3 IF '$TEST
QUIT
+4 NEW X,Y,Z,VSTG,DFN,HLIEN,VDT,PRVIEN,VIEN
+5 SET DFN=+IN
IF '$DATA(^DPT(DFN,0))
QUIT
+6 SET %=$PIECE(IN,"|",2)
IF %=""
QUIT
+7 IF '$DATA(^DIC(40.7,+%,0))
QUIT
+8 IF $PIECE(%,";",3)'="A"
QUIT
+9 SET VDT=$PIECE(%,";",2)
IF (VDT\1)'?7N
QUIT
+10 SET PRVIEN=$PIECE(IN,"|",3)
IF PRVIEN
IF '$DATA(^VA(200,PRVIEN,0))
QUIT
+11 SET OUT=$$VSTR2VIS^BEHOENCX(DFN,%,1,PRVIEN)
+12 QUIT
+13 ;
