VENPCCYR.m

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