XINDX12 ;OSE/CJE - Create phantom routines for build components ;03/01/2018 8:37 AM
;;7.3;TOOLKIT;**140,147,148**;Apr 25, 1995;Build 3
; Per VHA Directive 2004-038, this routine should not be modified.
; Entire routine authored by Chirstopher Edwards
; p148 remove all status writes, they are now done in XINDX11
; Variables passed through the stack:
; B = {IEN}
; INDLC = {counter}
; INDRN = {faux routine prefix}
; INDC = {IEN} ; {NAME} - {DISPLAY NAME}
; INDX = {code to be XINDEXED}
; INDL = {NAME field (.01) of IEN}
;
; FAUX Routine Structure
; ^UTILITY($J,1,INDRN,0,INDLC,0)={Field Name (INDC)}
; ^UTILITY($J,1,INDRN,0,INDLC+1,0)={MUMPS Code (INDX)}
;
SORT ;Process Sort Templates
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; .401 1815 ROUTINE INVOKED ^DIBT(D0,ROU)
; .401 1816 PREVIOUS ROUTINE INVOKED ^DIBT(D0,ROUOLD)
; .4014 10 GET CODE ^DIBT(D0,2,D1,GET) Part of Sort Field Data Subfile
; .4014 11 QUERY CONDITION ^DIBT(D0,2,D1,QCON) Part of Sort Field Data Subfile
; .4014 16 COMPUTED FIELD CODE ^DIBT(D0,2,D1,CM) Part of Sort Field Data Subfile
; .4014 20 SUBHEADER OUTPUT ^DIBT(D0,2,D1,OUT) Part of Sort Field Data Subfile
; .401418 5 RELATIONAL CODE ^DIBT(D0,2,D1,2,D2,RCOD) Part of Relational Jump Field Data Subfile
; .401419 2 OVERFLOW CODE ^DIBT(D0,2,D1,3,D2,OVF0) Part of Overflow Data Subfile
; .4011624 4 DISPAR(0,n,OUT) ^DIBT(D0,BY0D,D1,2) Part of Sort Range Data For BY(0)
; ======== ===== =============================== =================================== =============================================
S INDX=$S($L($G(^DIBT(B,"ROU"))):"D "_$G(^DIBT(B,"ROU")),1:";")
S INDC=B_" ; "_INDL_" - ROUTINE INVOKED (#1815)"
D ADD^XINDX11
;
S INDX=$S($L($G(^DIBT(B,"ROUOLD"))):"D ^"_$G(^DIBT(B,"ROUOLD")),1:";")
S INDC=" ; "_INDL_" - PREVIOUS ROUTINE INVOKED (#1816)"
D ADD^XINDX11
;
N SUB,SUB2
S (SUB,SUB2)=""
F S SUB=$O(^DIBT(B,2,SUB)) Q:SUB="" Q:SUB'=+SUB D
. S INDX=$S($L($G(^DIBT(B,2,SUB,"GET"))):$G(^DIBT(B,2,SUB,"GET")),1:";")
. S INDC=B_"P"_SUB_" ; "_INDL_" - GET CODE (#10) - "_SUB
. D ADD^XINDX11
. ;
. S INDX=$S($L($G(^DIBT(B,2,SUB,"QCON"))):$G(^DIBT(B,2,SUB,"QCON")),1:";")
. S INDC=" ; "_INDL_" - QUERY CONDITION (#11) - "_SUB
. D ADD^XINDX11
. ;
. S INDX=$S($L($G(^DIBT(B,2,SUB,"CM"))):$G(^DIBT(B,2,SUB,"CM")),1:";")
. S INDC=" ; "_INDL_" - COMPUTED FIELD CODE (#16) - "_SUB
. D ADD^XINDX11
. ;
. S INDX=$S($L($G(^DIBT(B,2,SUB,"OUT"))):$G(^DIBT(B,2,SUB,"OUT")),1:";")
. S INDC=" ; "_INDL_" - SUBHEADER OUTPUT (#20) - "_SUB
. D ADD^XINDX11
. ;
. F S SUB2=$O(^DIBT(B,2,SUB,2,SUB2)) Q:SUB2="" Q:SUB2'=+SUB2 D
. . S INDX=$S($L($G(^DIBT(B,2,SUB,2,SUB2,"RCOD"))):$G(^DIBT(B,2,SUB,2,SUB2,"RCOD")),1:";")
. . S INDC=B_"RCOD"_SUB_"P"_SUB2_" ; "_INDL_" - RELATIONAL CODE (#5) - "_SUB_" - "_SUB2
. . D ADD^XINDX11
. ;
. S SUB2=""
. F S SUB2=$O(^DIBT(B,2,SUB,3,SUB2)) Q:SUB2="" Q:SUB2'=+SUB2 D
. . S INDX=$S($L($G(^DIBT(B,2,SUB,3,SUB2,"OVF0"))):$G(^DIBT(B,2,SUB,3,SUB2,"OVF0")),1:";")
. . S INDC=B_"OVF0"_SUB_"P"_SUB2_" ; "_INDL_" - OVERFLOW CODE (#2) - "_SUB_" - "_SUB2
. . D ADD^XINDX11
;
S SUB=""
F S SUB=$O(^DIBT(B,"BY0D",SUB)) Q:SUB="" Q:SUB'=+SUB D
. S INDX=$S($L($G(^DIBT(B,"BY0D",SUB,2))):$G(^DIBT(B,"BY0D",SUB,2)),1:";")
. S INDC=B_"BY0D"_SUB_" ; "_INDL_" - DISPAR (#4) - "_SUB
. D ADD^XINDX11
Q
; Input and Print templates are implemented in XINDX13
; The executable code doesn't have defined field numbers in the DD,
; So we put all of the lines together as "EXECUTABLE CODE"
; Thanks to Sam Habiel for the implementation requried to support this.
INPUT ; Input Templates
S INDC=B_" ; "_INDL_" - EXECUTABLE CODE"
D ADD^XINDX11
D DIETM^XINDX13
Q
PRINT ; Print Templates
S INDC=B_" ; "_INDL_" - EXECUTABLE CODE"
D ADD^XINDX11
D DIPTM^XINDX13
Q
FORM ;Process Forms
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; .403 11 PRE ACTION ^DIST(.403,D0,11)
; .403 12 POST ACTION ^DIST(.403,D0,12)
; .403 14 POST SAVE ^DIST(.403,D0,14)
; .403 20 DATA VALIDATION ^DIST(.403,D0,20)
; .4031 11 PRE ACTION ^DIST(.403,D0,40,D1,11)
; .4031 12 POST ACTION ^DIST(.403,D0,40,D1,12)
; .4032 11 PRE ACTION ^DIST(.403,D0,40,D1,40,D2,11)
; .4032 12 POST ACTION ^DIST(.403,D0,40,D1,40,D2,12)
; .4032 98 COMPUTED MULTIPLE ^DIST(.403,D0,40,D1,40,D2,COMP MUL)
; ======== ===== =============================== =================================== =============================================
S INDX=$S($L($G(^DIST(.403,B,11))):$G(^DIST(.403,B,11)),1:";")
S INDC=B_" ; "_INDL_" - PRE ACTION (#11)"
D ADD^XINDX11
;
S INDX=$S($L($G(^DIST(.403,B,12))):$G(^DIST(.403,B,12)),1:";")
S INDC=" ; "_INDL_" - POST ACTION (#12)"
D ADD^XINDX11
;
S INDX=$S($L($G(^DIST(.403,B,14))):$G(^DIST(.403,B,14)),1:";")
S INDC=" ; "_INDL_" - POST SAVE (#14)"
D ADD^XINDX11
;
S INDX=$S($L($G(^DIST(.403,B,20))):$G(^DIST(.403,B,20)),1:";")
S INDC=" ; "_INDL_" - DATA VALIDATION (#20)"
D ADD^XINDX11
;
N SUB,SUB2
S (SUB,SUB2)=""
F S SUB=$O(^DIST(.403,B,40,SUB)) Q:SUB="" Q:SUB'=+SUB D
. S INDX=$S($L($G(^DIST(.403,B,40,SUB,11))):$G(^DIST(.403,B,40,SUB,11)),1:";")
. S INDC=B_"P"_SUB_" ; "_INDL_" - PRE ACTION FILE (#.4031) FIELD (#11) - "_SUB
. D ADD^XINDX11
. ;
. S INDX=$S($L($G(^DIST(.403,B,40,SUB,12))):$G(^DIST(.403,B,40,SUB,12)),1:";")
. S INDC=" ; "_INDL_" - POST ACTION FILE (#.4031) FIELD (#12) - "_SUB
. D ADD^XINDX11
. ;
. F S SUB2=$O(^DIST(.403,B,40,SUB,40,SUB2)) Q:SUB2="" Q:SUB2'=+SUB2 D
. . S INDX=$S($L($G(^DIST(.403,B,40,SUB,40,SUB2,11))):$G(^DIST(.403,B,40,SUB,40,SUB2,11)),1:";")
. . S INDC=B_"P"_SUB_"P"_SUB2_" ; "_INDL_" - PRE ACTION FILE (#.4032) FIELD (#11) - "_SUB_" - "_SUB2
. . D ADD^XINDX11
. . ;
. . S INDX=$S($L($G(^DIST(.403,B,40,SUB,40,SUB2,12))):$G(^DIST(.403,B,40,SUB,40,SUB2,12)),1:";")
. . S INDC=" ; "_INDL_" - POST ACTION FILE (#.4032) FIELD (#12) - "_SUB_" - "_SUB2
. . D ADD^XINDX11
. . ;
. . S INDX=$S($L($G(^DIST(.403,B,40,SUB,40,SUB2,"COMP MUL"))):$G(^DIST(.403,B,40,SUB,40,SUB2,"COMP MUL")),1:";")
. . S INDC=" ; "_INDL_" - COMPUTED MULTIPLE FILE (#.4032) FIELD (#98) - "_SUB_" - "_SUB2
. . D ADD^XINDX11
Q
DIALOG ;Process Dialogs
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; .84 6 POST MESSAGE ACTION ^DI(.84,D0,6)
; ======== ===== =============================== =================================== =============================================
S INDX=$S($L($G(^DI(.84,B,6))):$G(^DI(.84,B,6)),1:";")
S INDC=B_" ; "_INDL_" - POST MESSAGE ACTION (#6)"
D ADD^XINDX11
Q
HELP ;Process Help Frames
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; 9.2 10.1 ENTRY EXECUTE STATEMENT ^DIC(9.2,D0,10.1)
; 9.2 10.2 EXIT EXECUTE STATEMENT ^DIC(9.2,D0,10.2)
; ======== ===== =============================== =================================== =============================================
S INDX=$S($L($G(^DIC(9.2,B,10.1))):$G(^DIC(9.2,B,10.1)),1:";")
S INDC=B_" ; "_INDL_" - ENTRY EXECUTE STATEMENT (#10.1)"
D ADD^XINDX11
;
S INDX=$S($L($G(^DIC(9.2,B,10.2))):$G(^DIC(9.2,B,10.2)),1:";")
S INDC=" ; "_INDL_" - EXIT EXECUTE STATEMENT (#10.2)"
D ADD^XINDX11
Q
KEY ;Process Security Keys
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; 19.1 4 GRANTING CONDITION ^DIC(19.1,D0,4)
; ======== ===== =============================== =================================== =============================================
S INDX=$S($L($G(^DIC(19.1,B,4))):$G(^DIC(19.1,B,4)),1:";")
S INDC=B_" ; "_INDL_" - GRANTING CONDITION (#4)"
D ADD^XINDX11
Q
LIST ;Process List Templates
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; 409.61 100 HEADER CODE ^SD(409.61,D0,HDR)
; 409.61 102 EXPAND CODE ^SD(409.61,D0,EXP)
; 409.61 103 HELP CODE ^SD(409.61,D0,HLP)
; 409.61 105 EXIT CODE ^SD(409.61,D0,FNL)
; 409.61 106 ENTRY CODE ^SD(409.61,D0,INIT)
; 409.61 107 ARRAY NAME ^SD(409.61,D0,ARRAY) Holds a variable name prefaced by a space
; ======== ===== =============================== =================================== =============================================
S INDX=$S($L($G(^SD(409.61,B,"HDR"))):$G(^SD(409.61,B,"HDR")),1:";")
S INDC=B_" ; "_INDL_" - HEADER CODE (#100)"
D ADD^XINDX11
;
S INDX=$S($L($G(^SD(409.61,B,"EXP"))):$G(^SD(409.61,B,"EXP")),1:";")
S INDC=" ; "_INDL_" - EXPAND CODE (#102)"
D ADD^XINDX11
;
S INDX=$S($L($G(^SD(409.61,B,"HLP"))):$G(^SD(409.61,B,"HLP")),1:";")
S INDC=" ; "_INDL_" - HELP CODE (#103)"
D ADD^XINDX11
;
S INDX=$S($L($G(^SD(409.61,B,"FNL"))):$G(^SD(409.61,B,"FNL")),1:";")
S INDC=" ; "_INDL_" - EXIT CODE (#105)"
D ADD^XINDX11
;
S INDX=$S($L($G(^SD(409.61,B,"INIT"))):$G(^SD(409.61,B,"INIT")),1:";")
S INDC=" ; "_INDL_" - ENTRY CODE (#106)"
D ADD^XINDX11
;
N INDX1 ;p147 - remove space preceding ARRAY NAME
S INDX1=$G(^SD(409.61,B,"ARRAY"))
S INDX=$S($L(INDX1):"I $L("_$S($E(INDX1)=" ":$E(INDX1,2,50),1:INDX1)_") Q",1:";")
S INDC=" ; "_INDL_" - ARRAY NAME (#107)"
D ADD^XINDX11
Q
PROTOCOL ;Process Protocols
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; 101 15 EXIT ACTION ^ORD(101,D0,15) E1,245
; 101 20 ENTRY ACTION ^ORD(101,D0,20) E1,245
; 101 24 SCREEN ^ORD(101,D0,24) E1,245
; 101 26 HEADER ^ORD(101,D0,26) E1,245
; 101 27 MENU HELP ^ORD(101,D0,27) E1,245
; 101 100 ORDER PRINT ACTION ^ORD(101,D0,100) E1,245
; 101 100.1 ORDER CANCEL ACTION ^ORD(101,D0,100.1) E1,245
; 101 100.2 ORDER PURGE ACTION ^ORD(101,D0,100.2) E1,245
; 101 771 PROCESSING ROUTINE ^ORD(101,D0,771) E1,245
; 101 772 RESPONSE PROCESSING ROUTINE ^ORD(101,D0,772) E1,245
; 101 774 ROUTING LOGIC ^ORD(101,D0,774) E1,245
; 101 21 REQUIRED VARIABLES ^ORD(101,D0,21,D1,0) Required Variables sub file
; 101.05 .02 METHOD ACTION ^ORD(101,D0,101.05,D1,1) E1,245 Method sub file
; ======== ===== =============================== =================================== =============================================
K INDN
S INDN=$P($G(^ORD(101,B,0)),U,1)
S INDX=$S($L($G(^ORD(101,B,15))):$G(^ORD(101,B,15)),1:";")
S INDC=B_" ; "_INDN_" - EXIT ACTION (#15)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,20))):$G(^ORD(101,B,20)),1:";")
S INDC=" ; "_INDN_" - ENTRY ACTION (#20)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,24))):$G(^ORD(101,B,24)),1:";")
S INDC=" ; "_INDN_" - SCREEN (#24)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,26))):$G(^ORD(101,B,26)),1:";")
S INDC=" ; "_INDN_" - HEADER (#26)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,27))):$G(^ORD(101,B,27)),1:";")
S INDC=" ; "_INDN_" - MENU HELP (#27)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,100))):$G(^ORD(101,B,100)),1:";")
S INDC=" ; "_INDN_" - ORDER PRINT ACTION (#100)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,100.1))):$G(^ORD(101,B,100.1)),1:";")
S INDC=" ; "_INDN_" - ORDER CANCEL ACTION (#100.1)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,100.2))):$G(^ORD(101,B,100.2)),1:";")
S INDC=" ; "_INDN_" - ORDER PURGE ACTION (#100.2)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,771))):$G(^ORD(101,B,771)),1:";")
S INDC=" ; "_INDN_" - PROCESSING ROUTINE (#771)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,772))):$G(^ORD(101,B,772)),1:";")
S INDC=" ; "_INDN_" - ORDER PURGE ACTION (#772)"
D ADD^XINDX11
;
S INDX=$S($L($G(^ORD(101,B,774))):$G(^ORD(101,B,774)),1:";")
S INDC=" ; "_INDN_" - ROUTING LOGIC (#774)"
D ADD^XINDX11
;
N SUB
S SUB=""
;F S SUB=$O(^ORD(101,B,21,SUB)) Q:SUB="" Q:SUB'=+SUB D
;why does a list of required variable needs to check the HL7 MESSAGE (#6) field, which is no longer used rsd
;. S INDX=$S($L($E($G(^ORD(101,B,21,SUB,0)),1,17)):"$G("_$E($G(^HL(771,B,"MSG",SUB,"R")),1,17)_")",1:";")
;. I INDX="D Q" S INDX=";"
;. S INDC=B_"R"_SUB_" ; "_INDN_" - REQUIRED VARIABLES SUB FILE (#101.021) REQUIRED VARIABLES (#1) - "_SUB
;. D ADD^XINDX11
;
S SUB=""
F S SUB=$O(^ORD(101,B,101.05,SUB)) Q:SUB="" Q:SUB'=+SUB D
. S INDX=$S($L($G(^ORD(101,B,101.05,SUB,1))):$G(^ORD(101,B,101.05,SUB,1)),1:";")
. I INDX="D Q" S INDX=";"
. S INDC=B_"M"_SUB_" ; "_INDN_" - METHOD SUB FILE (#101.05) METHOD ACTION (#.02) - "_SUB
. D ADD^XINDX11
;
Q
HL7AP ; Process HL7 Application Parameters
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; 771.06 1 PROCESSING ROUTINE ^HL(771,D0,MSG,D1,R)
; ======== ===== =============================== =================================== =============================================
N SUB
S SUB=""
F S SUB=$O(^HL(771,B,"MSG",SUB)) Q:SUB="" Q:SUB'=+SUB D
. S INDX=$S($L($G(^HL(771,B,"MSG",SUB,"R"))):"D "_$G(^HL(771,B,"MSG",SUB,"R")),1:";")
. I INDX="D Q" S INDX=";"
. S INDC=B_"P"_SUB_" ; "_INDL_" - HL7 MESSAGE SUB FILE (#771.06) PROCESSING ROUTINE (#1) - "_SUB
. D ADD^XINDX11
Q
RPC ; Process Remote Procedures
; ======== ===== =============================== =================================== =============================================
; File Field Field Name Global Location Comments
; ======== ===== =============================== =================================== =============================================
; 8994 .02 TAG ^XWB(8994,D0,0) Piece 2 Needs to be concatenated with ROUTINE
; 8994 .03 ROUTINE ^XWB(8994,D0,0) Piece 3
; ======== ===== =============================== =================================== =============================================
S INDX=$S($L($P($G(^XWB(8994,B,0)),U,2))&($L($P($G(^XWB(8994,B,0)),U,3))):"D "_$P($G(^XWB(8994,B,0)),U,2)_"^"_$P($G(^XWB(8994,B,0)),U,3),1:";")
S INDC=B_" ; "_INDL_" - TAG ROUTINE (#.02 & .03)"
D ADD^XINDX11
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXINDX12 18246 printed Dec 13, 2024@02:39:59 Page 2
XINDX12 ;OSEHRA/CJE - Create phantom routines for build components ;2018-03-01 8:37 AM
+1 ;;7.3;TOOLKIT;**10001**;Apr 25, 1995;Build 4
+2 ; Entire routine authored by Chirstopher Edwards
+3 ;
+4 ; Variables passed through the stack:
+5 ; B = {IEN}
+6 ; INDLC = {counter}
+7 ; INDRN = {faux routine prefix}
+8 ; INDC = {IEN} ; {NAME} - {DISPLAY NAME}
+9 ; INDX = {code to be XINDEXED}
+10 ; INDL = {NAME field (.01) of IEN}
+11 ;
+12 ; FAUX Routine Structure
+13 ; ^UTILITY($J,1,INDRN,0,INDLC,0)={Field Name (INDC)}
+14 ; ^UTILITY($J,1,INDRN,0,INDLC+1,0)={MUMPS Code (INDX)}
+15 ;
SORT ;Process Sort Templates
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; .401 1815 ROUTINE INVOKED ^DIBT(D0,ROU)
+5 ; .401 1816 PREVIOUS ROUTINE INVOKED ^DIBT(D0,ROUOLD)
+6 ; .4014 10 GET CODE ^DIBT(D0,2,D1,GET) Part of Sort Field Data Subfile
+7 ; .4014 11 QUERY CONDITION ^DIBT(D0,2,D1,QCON) Part of Sort Field Data Subfile
+8 ; .4014 16 COMPUTED FIELD CODE ^DIBT(D0,2,D1,CM) Part of Sort Field Data Subfile
+9 ; .4014 20 SUBHEADER OUTPUT ^DIBT(D0,2,D1,OUT) Part of Sort Field Data Subfile
+10 ; .401418 5 RELATIONAL CODE ^DIBT(D0,2,D1,2,D2,RCOD) Part of Relational Jump Field Data Subfile
+11 ; .401419 2 OVERFLOW CODE ^DIBT(D0,2,D1,3,D2,OVF0) Part of Overflow Data Subfile
+12 ; .4011624 4 DISPAR(0,n,OUT) ^DIBT(D0,BY0D,D1,2) Part of Sort Range Data For BY(0)
+13 ; ======== ===== =============================== =================================== =============================================
+14 WRITE !,"Processing Sort Templates",!
+15 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,"ROU")),U,1)):"D ^"_$PIECE($GET(^DIBT(B,"ROU")),U,1),1:";")
+16 SET INDC=B_" ; "_INDL_" - ROUTINE INVOKED (#1815)"
+17 DO ADD^XINDX11
+18 ;
+19 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,"ROUOLD")),U,1)):"D ^"_$PIECE($GET(^DIBT(B,"ROUOLD")),U,1),1:";")
+20 SET INDC=" ; "_INDL_" - PREVIOUS ROUTINE INVOKED (#1816)"
+21 DO ADD^XINDX11
+22 ;
+23 NEW SUB,SUB2
+24 SET (SUB,SUB2)=""
+25 FOR
SET SUB=$ORDER(^DIBT(B,2,SUB))
if SUB=""
QUIT
if SUB'=+SUB
QUIT
Begin DoDot:1
+26 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,2,SUB,"GET")),U,1)):$GET(^DIBT(B,2,SUB,"GET")),1:";")
+27 SET INDC=B_"P"_SUB_" ; "_INDL_" - GET CODE (#10) - "_SUB
+28 DO ADD^XINDX11
+29 ;
+30 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,2,SUB,"QCON")),U,1)):$GET(^DIBT(B,2,SUB,"QCON")),1:";")
+31 SET INDC=" ; "_INDL_" - QUERY CONDITION (#11) - "_SUB
+32 DO ADD^XINDX11
+33 ;
+34 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,2,SUB,"CM")),U,1)):$GET(^DIBT(B,2,SUB,"CM")),1:";")
+35 SET INDC=" ; "_INDL_" - COMPUTED FIELD CODE (#16) - "_SUB
+36 DO ADD^XINDX11
+37 ;
+38 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,2,SUB,"OUT")),U,1)):$GET(^DIBT(B,2,SUB,"OUT")),1:";")
+39 SET INDC=" ; "_INDL_" - SUBHEADER OUTPUT (#20) - "_SUB
+40 DO ADD^XINDX11
+41 ;
+42 FOR
SET SUB2=$ORDER(^DIBT(B,2,SUB,2,SUB2))
if SUB2=""
QUIT
if SUB2'=+SUB2
QUIT
Begin DoDot:2
+43 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,2,SUB,2,SUB2,"RCOD")),U,1)):$GET(^DIBT(B,2,SUB,2,SUB2,"RCOD")),1:";")
+44 SET INDC=B_"RCOD"_SUB_"P"_SUB2_" ; "_INDL_" - RELATIONAL CODE (#5) - "_SUB_" - "_SUB2
+45 DO ADD^XINDX11
End DoDot:2
+46 ;
+47 SET SUB2=""
+48 FOR
SET SUB2=$ORDER(^DIBT(B,2,SUB,3,SUB2))
if SUB2=""
QUIT
if SUB2'=+SUB2
QUIT
Begin DoDot:2
+49 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,2,SUB,3,SUB2,"OVF0")),U,1)):$GET(^DIBT(B,2,SUB,3,SUB2,"OVF0")),1:";")
+50 SET INDC=B_"OVF0"_SUB_"P"_SUB2_" ; "_INDL_" - OVERFLOW CODE (#2) - "_SUB_" - "_SUB2
+51 DO ADD^XINDX11
End DoDot:2
End DoDot:1
+52 ;
+53 SET SUB=""
+54 FOR
SET SUB=$ORDER(^DIBT(B,"BY0D",SUB))
if SUB=""
QUIT
if SUB'=+SUB
QUIT
Begin DoDot:1
+55 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIBT(B,"BY0D",SUB,2)),U,1)):$GET(^DIBT(B,"BY0D",SUB,2)),1:";")
+56 SET INDC=B_"BY0D"_SUB_" ; "_INDL_" - DISPAR (#4) - "_SUB
+57 DO ADD^XINDX11
End DoDot:1
+58 QUIT
+59 ; Input and Print templates are implemented in XINDX13
+60 ; The executable code doesn't have defined field numbers in the DD,
+61 ; So we put all of the lines together as "EXECUTABLE CODE"
+62 ; Thanks to Sam Habiel for the implementation requried to support this.
INPUT ; Input Templates
+1 WRITE !,"Processing Input Templates",!
+2 SET INDC=B_" ; "_INDL_" - EXECUTABLE CODE"
+3 DO ADD^XINDX11
+4 DO DIETM^XINDX13
+5 QUIT
PRINT ; Print Templates
+1 WRITE !,"Processing Print Templates",!
+2 SET INDC=B_" ; "_INDL_" - EXECUTABLE CODE"
+3 DO ADD^XINDX11
+4 DO DIPTM^XINDX13
+5 QUIT
FORM ;Process Forms
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; .403 11 PRE ACTION ^DIST(.403,D0,11)
+5 ; .403 12 POST ACTION ^DIST(.403,D0,12)
+6 ; .403 14 POST SAVE ^DIST(.403,D0,14)
+7 ; .403 20 DATA VALIDATION ^DIST(.403,D0,20)
+8 ; .4031 11 PRE ACTION ^DIST(.403,D0,40,D1,11)
+9 ; .4031 12 POST ACTION ^DIST(.403,D0,40,D1,12)
+10 ; .4032 11 PRE ACTION ^DIST(.403,D0,40,D1,40,D2,11)
+11 ; .4032 12 POST ACTION ^DIST(.403,D0,40,D1,40,D2,12)
+12 ; .4032 98 COMPUTED MULTIPLE ^DIST(.403,D0,40,D1,40,D2,COMP MUL)
+13 ; ======== ===== =============================== =================================== =============================================
+14 WRITE !,"Processing Forms",!
+15 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,11)),U,1)):$PIECE($GET(^DIST(.403,B,11)),U,1),1:";")
+16 SET INDC=B_" ; "_INDL_" - PRE ACTION (#11)"
+17 DO ADD^XINDX11
+18 ;
+19 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,12)),U,1)):$PIECE($GET(^DIST(.403,B,12)),U,1),1:";")
+20 SET INDC=" ; "_INDL_" - POST ACTION (#12)"
+21 DO ADD^XINDX11
+22 ;
+23 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,14)),U,1)):$PIECE($GET(^DIST(.403,B,14)),U,1),1:";")
+24 SET INDC=" ; "_INDL_" - POST SAVE (#14)"
+25 DO ADD^XINDX11
+26 ;
+27 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,20)),U,1)):$PIECE($GET(^DIST(.403,B,20)),U,1),1:";")
+28 SET INDC=" ; "_INDL_" - DATA VALIDATION (#20)"
+29 DO ADD^XINDX11
+30 ;
+31 NEW SUB,SUB2
+32 SET (SUB,SUB2)=""
+33 FOR
SET SUB=$ORDER(^DIST(.403,B,40,SUB))
if SUB=""
QUIT
if SUB'=+SUB
QUIT
Begin DoDot:1
+34 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,40,SUB,11)),U,1)):$PIECE($GET(^DIST(.403,B,40,SUB,11)),U,1),1:";")
+35 SET INDC=B_"P"_SUB_" ; "_INDL_" - PRE ACTION FILE (#.4031) FIELD (#11) - "_SUB
+36 DO ADD^XINDX11
+37 ;
+38 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,40,SUB,12)),U,1)):$PIECE($GET(^DIST(.403,B,40,SUB,12)),U,1),1:";")
+39 SET INDC=" ; "_INDL_" - POST ACTION FILE (#.4031) FIELD (#12) - "_SUB
+40 DO ADD^XINDX11
+41 ;
+42 FOR
SET SUB2=$ORDER(^DIST(.403,B,40,SUB,40,SUB2))
if SUB2=""
QUIT
if SUB2'=+SUB2
QUIT
Begin DoDot:2
+43 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,40,SUB,40,SUB2,11)),U,1)):$PIECE($GET(^DIST(.403,B,40,SUB,40,SUB2,11)),U,1),1:";")
+44 SET INDC=B_"P"_SUB_"P"_SUB2_" ; "_INDL_" - PRE ACTION FILE (#.4032) FIELD (#11) - "_SUB_" - "_SUB2
+45 DO ADD^XINDX11
+46 ;
+47 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,40,SUB,40,SUB2,12)),U,1)):$PIECE($GET(^DIST(.403,B,40,SUB,40,SUB2,12)),U,1),1:";")
+48 SET INDC=" ; "_INDL_" - POST ACTION FILE (#.4032) FIELD (#12) - "_SUB_" - "_SUB2
+49 DO ADD^XINDX11
+50 ;
+51 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIST(.403,B,40,SUB,40,SUB2,"COMP MUL")),U,1)):$PIECE($GET(^DIST(.403,B,40,SUB,40,SUB2,"COMP MUL")),U,1),1:";")
+52 SET INDC=" ; "_INDL_" - COMPUTED MULTIPLE FILE (#.4032) FIELD (#98) - "_SUB_" - "_SUB2
+53 DO ADD^XINDX11
End DoDot:2
End DoDot:1
+54 QUIT
DIALOG ;Process Dialogs
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; .84 6 POST MESSAGE ACTION ^DI(.84,D0,6)
+5 ; ======== ===== =============================== =================================== =============================================
+6 WRITE !,"Processing Dialogs",!
+7 SET INDX=$SELECT($LENGTH($PIECE($GET(^DI(.84,B,6)),U,1)):$PIECE($GET(^DI(.84,B,6)),U,1),1:";")
+8 SET INDC=B_" ; "_INDL_" - POST MESSAGE ACTION (#6)"
+9 DO ADD^XINDX11
+10 QUIT
HELP ;Process Help Frames
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; 9.2 10.1 ENTRY EXECUTE STATEMENT ^DIC(9.2,D0,10.1)
+5 ; 9.2 10.2 EXIT EXECUTE STATEMENT ^DIC(9.2,D0,10.2)
+6 ; ======== ===== =============================== =================================== =============================================
+7 WRITE !,"Processing Help Frames",!
+8 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIC(9.2,B,10.1)),U,1)):$PIECE($GET(^DIC(9.2,B,10.1)),U,1),1:";")
+9 SET INDC=B_" ; "_INDL_" - ENTRY EXECUTE STATEMENT (#10.1)"
+10 DO ADD^XINDX11
+11 ;
+12 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIC(9.2,B,10.2)),U,1)):$PIECE($GET(^DIC(9.2,B,10.2)),U,1),1:";")
+13 SET INDC=" ; "_INDL_" - EXIT EXECUTE STATEMENT (#10.2)"
+14 DO ADD^XINDX11
+15 QUIT
KEY ;Process Security Keys
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; 19.1 4 GRANTING CONDITION ^DIC(19.1,D0,4)
+5 ; ======== ===== =============================== =================================== =============================================
+6 WRITE !,"Processing Security Keys",!
+7 SET INDX=$SELECT($LENGTH($PIECE($GET(^DIC(19.1,B,4)),U,1)):$PIECE($GET(^DIC(19.1,B,4)),U,1),1:";")
+8 SET INDC=B_" ; "_INDL_" - GRANTING CONDITION (#4)"
+9 DO ADD^XINDX11
+10 QUIT
LIST ;Process List Templates
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; 409.61 100 HEADER CODE ^SD(409.61,D0,HDR)
+5 ; 409.61 102 EXPAND CODE ^SD(409.61,D0,EXP)
+6 ; 409.61 103 HELP CODE ^SD(409.61,D0,HLP)
+7 ; 409.61 105 EXIT CODE ^SD(409.61,D0,FNL)
+8 ; 409.61 106 ENTRY CODE ^SD(409.61,D0,INIT)
+9 ; 409.61 107 ARRAY NAME ^SD(409.61,D0,ARRAY) Holds a variable name prefaced by a space
+10 ; ======== ===== =============================== =================================== =============================================
+11 WRITE !,"Processing List Templates",!
+12 SET INDX=$SELECT($LENGTH($GET(^SD(409.61,B,"HDR"))):$GET(^SD(409.61,B,"HDR")),1:";")
+13 SET INDC=B_" ; "_INDL_" - HEADER CODE (#100)"
+14 DO ADD^XINDX11
+15 ;
+16 SET INDX=$SELECT($LENGTH($GET(^SD(409.61,B,"EXP"))):$GET(^SD(409.61,B,"EXP")),1:";")
+17 SET INDC=" ; "_INDL_" - EXPAND CODE (#102)"
+18 DO ADD^XINDX11
+19 ;
+20 SET INDX=$SELECT($LENGTH($GET(^SD(409.61,B,"HLP"))):$GET(^SD(409.61,B,"HLP")),1:";")
+21 SET INDC=" ; "_INDL_" - HELP CODE (#103)"
+22 DO ADD^XINDX11
+23 ;
+24 SET INDX=$SELECT($LENGTH($GET(^SD(409.61,B,"FNL"))):$GET(^SD(409.61,B,"FNL")),1:";")
+25 SET INDC=" ; "_INDL_" - EXIT CODE (#105)"
+26 DO ADD^XINDX11
+27 ;
+28 SET INDX=$SELECT($LENGTH($GET(^SD(409.61,B,"INIT"))):$GET(^SD(409.61,B,"INIT")),1:";")
+29 SET INDC=" ; "_INDL_" - ENTRY CODE (#106)"
+30 DO ADD^XINDX11
+31 ;
+32 SET INDX=$SELECT($LENGTH($GET(^SD(409.61,B,"ARRAY"))):"I $L("_$PIECE($GET(^SD(409.61,B,"ARRAY"))," ",2,99)_") Q",1:";")
+33 SET INDC=" ; "_INDL_" - ARRAY NAME (#107)"
+34 DO ADD^XINDX11
+35 QUIT
PROTOCOL ;Process Protocols
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; 101 15 EXIT ACTION ^ORD(101,D0,15) E1,245
+5 ; 101 20 ENTRY ACTION ^ORD(101,D0,20) E1,245
+6 ; 101 24 SCREEN ^ORD(101,D0,24) E1,245
+7 ; 101 26 HEADER ^ORD(101,D0,26) E1,245
+8 ; 101 27 MENU HELP ^ORD(101,D0,27) E1,245
+9 ; 101 100 ORDER PRINT ACTION ^ORD(101,D0,100) E1,245
+10 ; 101 100.1 ORDER CANCEL ACTION ^ORD(101,D0,100.1) E1,245
+11 ; 101 100.2 ORDER PURGE ACTION ^ORD(101,D0,100.2) E1,245
+12 ; 101 771 PROCESSING ROUTINE ^ORD(101,D0,771) E1,245
+13 ; 101 772 RESPONSE PROCESSING ROUTINE ^ORD(101,D0,772) E1,245
+14 ; 101 774 ROUTING LOGIC ^ORD(101,D0,774) E1,245
+15 ; 101 21 REQUIRED VARIABLES ^ORD(101,D0,21,D1,0) Required Variables sub file
+16 ; 101.05 .02 METHOD ACTION ^ORD(101,D0,101.05,D1,1) E1,245 Method sub file
+17 ; ======== ===== =============================== =================================== =============================================
+18 WRITE !,"Processing Protocols",!
+19 KILL INDN
+20 SET INDN=$PIECE($GET(^ORD(101,B,0)),U,1)
+21 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,15)),1,245)):$EXTRACT($GET(^ORD(101,B,15)),1,245),1:";")
+22 SET INDC=B_" ; "_INDN_" - EXIT ACTION (#15)"
+23 DO ADD^XINDX11
+24 ;
+25 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,20)),1,245)):$EXTRACT($GET(^ORD(101,B,20)),1,245),1:";")
+26 SET INDC=" ; "_INDN_" - ENTRY ACTION (#20)"
+27 DO ADD^XINDX11
+28 ;
+29 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,24)),1,245)):$EXTRACT($GET(^ORD(101,B,24)),1,245),1:";")
+30 SET INDC=" ; "_INDN_" - SCREEN (#24)"
+31 DO ADD^XINDX11
+32 ;
+33 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,26)),1,245)):$EXTRACT($GET(^ORD(101,B,26)),1,245),1:";")
+34 SET INDC=" ; "_INDN_" - HEADER (#26)"
+35 DO ADD^XINDX11
+36 ;
+37 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,27)),1,245)):$EXTRACT($GET(^ORD(101,B,27)),1,245),1:";")
+38 SET INDC=" ; "_INDN_" - MENU HELP (#27)"
+39 DO ADD^XINDX11
+40 ;
+41 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,100)),1,245)):$EXTRACT($GET(^ORD(101,B,100)),1,245),1:";")
+42 SET INDC=" ; "_INDN_" - ORDER PRINT ACTION (#100)"
+43 DO ADD^XINDX11
+44 ;
+45 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,100.1)),1,245)):$EXTRACT($GET(^ORD(101,B,100.1)),1,245),1:";")
+46 SET INDC=" ; "_INDN_" - ORDER CANCEL ACTION (#100.1)"
+47 DO ADD^XINDX11
+48 ;
+49 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,100.2)),1,245)):$EXTRACT($GET(^ORD(101,B,100.2)),1,245),1:";")
+50 SET INDC=" ; "_INDN_" - ORDER PURGE ACTION (#100.2)"
+51 DO ADD^XINDX11
+52 ;
+53 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,771)),1,245)):$EXTRACT($GET(^ORD(101,B,771)),1,245),1:";")
+54 SET INDC=" ; "_INDN_" - PROCESSING ROUTINE (#771)"
+55 DO ADD^XINDX11
+56 ;
+57 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,772)),1,245)):$EXTRACT($GET(^ORD(101,B,772)),1,245),1:";")
+58 SET INDC=" ; "_INDN_" - ORDER PURGE ACTION (#772)"
+59 DO ADD^XINDX11
+60 ;
+61 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,774)),1,245)):$EXTRACT($GET(^ORD(101,B,774)),1,245),1:";")
+62 SET INDC=" ; "_INDN_" - ROUTING LOGIC (#774)"
+63 DO ADD^XINDX11
+64 ;
+65 NEW SUB
+66 SET SUB=""
+67 FOR
SET SUB=$ORDER(^ORD(101,B,21,SUB))
if SUB=""
QUIT
if SUB'=+SUB
QUIT
Begin DoDot:1
+68 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,21,SUB,0)),1,17)):"$G("_$EXTRACT($GET(^HL(771,B,"MSG",SUB,"R")),1,17)_")",1:";")
+69 IF INDX="D Q"
SET INDX=";"
+70 SET INDC=B_"R"_SUB_" ; "_INDN_" - REQUIRED VARIABLES SUB FILE (#101.021) REQUIRED VARIABLES (#1) - "_SUB
+71 DO ADD^XINDX11
End DoDot:1
+72 ;
+73 SET SUB=""
+74 FOR
SET SUB=$ORDER(^ORD(101,B,101.05,SUB))
if SUB=""
QUIT
if SUB'=+SUB
QUIT
Begin DoDot:1
+75 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^ORD(101,B,101.05,SUB,1)),1,245)):$EXTRACT($GET(^ORD(101,B,101.05,SUB,1)),1,245),1:";")
+76 IF INDX="D Q"
SET INDX=";"
+77 SET INDC=B_"M"_SUB_" ; "_INDN_" - METHOD SUB FILE (#101.05) METHOD ACTION (#.02) - "_SUB
+78 DO ADD^XINDX11
End DoDot:1
+79 ;
+80 QUIT
HL7AP ; Process HL7 Application Parameters
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; 771.06 1 PROCESSING ROUTINE ^HL(771,D0,MSG,D1,R)
+5 ; ======== ===== =============================== =================================== =============================================
+6 WRITE !,"Processing HL7 Application Parameters",!
+7 NEW SUB
+8 SET SUB=""
+9 FOR
SET SUB=$ORDER(^HL(771,B,"MSG",SUB))
if SUB=""
QUIT
if SUB'=+SUB
QUIT
Begin DoDot:1
+10 SET INDX=$SELECT($LENGTH($EXTRACT($GET(^HL(771,B,"MSG",SUB,"R")),1,17)):"D "_$EXTRACT($GET(^HL(771,B,"MSG",SUB,"R")),1,17),1:";")
+11 IF INDX="D Q"
SET INDX=";"
+12 SET INDC=B_"P"_SUB_" ; "_INDL_" - HL7 MESSAGE SUB FILE (#771.06) PROCESSING ROUTINE (#1) - "_SUB
+13 DO ADD^XINDX11
End DoDot:1
+14 QUIT
RPC ; Process Remote Procedures
+1 ; ======== ===== =============================== =================================== =============================================
+2 ; File Field Field Name Global Location Comments
+3 ; ======== ===== =============================== =================================== =============================================
+4 ; 8994 .02 TAG ^XWB(8994,D0,0) Piece 2 Needs to be concatenated with ROUTINE
+5 ; 8994 .03 ROUTINE ^XWB(8994,D0,0) Piece 3
+6 ; ======== ===== =============================== =================================== =============================================
+7 WRITE !,"Processing Remote Procedures",!
+8 SET INDX=$SELECT($LENGTH($PIECE($GET(^XWB(8994,B,0)),U,2))&($LENGTH($PIECE($GET(^XWB(8994,B,0)),U,3))):"D "_$PIECE($GET(^XWB(8994,B,0)),U,2)_"^"_$PIECE($GET(^XWB(8994,B,0)),U,3),1:";")
+9 SET INDC=B_" ; "_INDL_" - TAG ROUTINE (#.02 & .03)"
+10 DO ADD^XINDX11
+11 QUIT
