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

INHSZ5.m

Go to the documentation of this file.
  1. INHSZ5 ;JSH; 16 Mar 92 08:35;Script compiler LOOKUP section handler ; 11 Nov 91 6:42 AM
  1. ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1. ;COPYRIGHT 1991-2000 SAIC
  1. ;
  1. L G L^INHSZ1
  1. ;
  1. IN ;Enter code
  1. D QCHK^INHSZ0
  1. Q
  1. ;
  1. OUT ;Exit code
  1. Q:REPEAT1&'REPEAT!LOOKUP
  1. D DOIT Q
  1. ;
  1. DOIT ;Perform the lookup
  1. S:LPARAM="" LPARAM="N"
  1. I 'IDENT D ERROR^INHSZ0("LOOKUP cannot be done without an IDENT command.",1) Q
  1. S A=" S INDAS=$G(INDA) K @INV@(""IDENT.001"") I '$G(INDA) D" D L,DOWN^INHSZ1("")
  1. ;First Try to find a match
  1. D:LPARAM'="F"
  1. . N F S F="^"_$$REPLACE^UTIL($P(FILE,"^",2),"""","""""")
  1. . S A=" K DA F I=1:1:MULT S DA(I)=INDA(I)" D L
  1. . S Q="""""""""" S A=" K DO,DIC S:$D(FIELD) DIC(""S"")=""N X,Z I 1 S INF="_Q_",D0=Y F S INF=$O(FIELD(INF)) Q:INF="_Q_"!'$T X FIELD(INF) X """"S Z=""""_FIELD(INF,1) I ((X="_Q_"!(Z="_Q_"))&(FIELD(INF,0)=""""N""""))!(X=Z)""" D L
  1. . I MULT,MULT0["P" S A=" I IDENT?1""`""1.NP S (@INV@(""IDENT.001""),Y)=$P(IDENT,""`"",2),C=$P(^DD("_+MULT0_",.01,0),""^"",2) D Y^DIQ S IDENT=Y,MDESC(2)="".01 = ""_Y" D L D
  1. .. N LINE,V,DICOMPX S V="IDENT.001",DICOMPX("IDENT.001")="",LINE="MATCH IDENT.001=INTERNAL(#.01);E" D MATCH
  1. . S A=" S DIC="""_F_""",DIC(0)=""Y"",X=IDENT K Y S Y=-1 D:$O(@(DIC_""0)"")) ^DIC K DIC S INDA=+Y" D L
  1. . S A=" I 'INDA S MDESC(1)=""Ambiguous lookup - multiple matched found in '"_$S(MULT:$P(^DD(+FILE,0),U)_"' in the '",1:"")_$P(^DIC(+FILE1,0),U)_"' file"" D ERROR^INHS(.MDESC,2)" D L
  1. I LPARAM="N" D
  1. . S A=" I INDA<0 S MDESC(1)=""Entry not found in '"_$S(MULT:$P(^DD(+FILE,0),U)_"' in the '",1:"")_$P(^DIC(+FILE1,0),U)_"' file"" D ERROR^INHS(.MDESC,1)" D L
  1. I LPARAM="L" D
  1. . S A=" D:INDA<0" D L S INDL(INRL)=""
  1. . D LAYGO^INHSZ51
  1. . I 'MULT S A=" I INDA<0 S MDESC(1)=""Could not create new entry in file #"_+FILE_" ("_$P(^DIC(+FILE,0),U)_")"" D ERROR^INHS(.MDESC,2)" D L
  1. . I MULT S A=" I INDA<0 S MDESC(1)=""Could not create new entry in "_$P(^DD(+FILE,0),U)_" in the "_$P(^DIC(+FILE1,0),U)_" file"" D ERROR^INHS(.MDESC,2)" D L
  1. I LPARAM="F" D
  1. . S A=" D" D L S INDL(INRL)=""
  1. . D LAYGO^INHSZ51
  1. . I 'MULT S A=" I INDA<0 S MDESC(1)=""Could not create new entry in file #"_+FILE_" ("_$P(^DIC(+FILE,0),U)_")"" D ERROR^INHS(.MDESC,2)" D L
  1. . I MULT S A=" I INDA<0 S MDESC(1)=""Could not create new entry in "_$P(^DD(+FILE,0),U)_" in the "_$P(^DIC(+FILE1,0),U)_" file"" D ERROR^INHS(.MDESC,2)" D L
  1. S LOOKUP=1 D UP^INHSZ1
  1. S A=" K @INV@(""IDENT.001"") I $G(INDAS)<0 D ERROR^INHS(""Programmer lookup failed (""_INDAS_"") in file #"_+FILE_""",$S(INDAS=-1:2,1:1))" D L
  1. I 'REPEAT,'OTHER,'MULT D QCHK^INHSZ0
  1. Q
  1. ;
  1. LOOKUP ;Handle lines in LOOKUP section
  1. ;Enter here with LINE array set
  1. N COMM
  1. S COMM=$$LBTB^UTIL($P(LINE," ")) I '$$CMD^INHSZ1(COMM,"SAVE^IF^ENDIF^IDENT^MATCH^PARAM^ERROR^REPEAT^ENDREPEAT^TEMPLATE^ROUTINE^LOOK") D ERROR^INHSZ0("Invalid command in LOOKUP section.",1) Q
  1. S X=$E($$CASECONV^UTIL(COMM,"U"),1,8) G:$T(@X)]"" @X
  1. G @(X_"^INHSZ51")
  1. ;
  1. IF G IF^INHSZ21
  1. ;
  1. ENDIF G ENDIF^INHSZ21
  1. ;
  1. ERROR G ERROR^INHSZ21
  1. ;
  1. IDENT ;
  1. Q:'$$SYNTAX^INHSZ0($P(LINE,COMM,2,99),"1."" ""1.ANP")
  1. N V
  1. S V=$$LBTB^UTIL($P(LINE," ",2,999))
  1. I '$D(DICOMPX(V)) D ERROR^INHSZ0("Variable '"_V_"' was not defined.",1) Q
  1. I $D(LVARS(V)),'REPEAT D ERROR^INHSZ0("Variable '"_V_"' was defined in a loop and cannot be used as identifier.",1) Q
  1. S A=" S IDENT=$G(@INV@("""_V_""")),MDESC(2)="" .01 = ""_IDENT" D L
  1. S IDENT=1,MCNT=2 Q
  1. ;
  1. MATCH ;Match other fields
  1. N %1,M,F,V,V1,A1
  1. S %1=$$LBTB^UTIL($P(LINE," ",2,999))
  1. Q:'$$SYNTAX^INHSZ0(%1,"1.ANP1""=""1.ANP")
  1. S:%1'?1.ANP1";"1A %1=%1_";E"
  1. S V=$$LBTB^UTIL($P(%1,"=")),F=$$LBTB^UTIL($P($P(%1,"=",2),";")),M=$$CASECONV^UTIL($$LBTB^UTIL($P(%1,";",2)),"U")
  1. I '$D(DICOMPX(V)) D WARN^INHSZ0("Variable '"_V_"' was not defined.",1) S DICOMPX(V)="$G(@INV@("""_V_"""))"
  1. I $D(LVARS(V)),LVARS(V)'=SLVL D ERROR^INHSZ0("Variable '"_V_"' was defined at a different level.",1) Q
  1. I "EN"'[M D ERROR^INHSZ0("Match specifier '"_M_"' is invalid.",1) Q
  1. S:+F F="#"_F
  1. S I(0)="^"_$P(FILE,U,2),J(0)=+FILE,DQI="Y(",DA="FIELD("""_V_""",",DICOMP="",X=F
  1. D
  1. . N DS,DL,DE,V,F,M,DICOMPX D ^DICOMP
  1. . I $D(X),Y["D" S X=X_" S Y=X D DD^%DT S X=Y"
  1. I '$D(X) D ERROR^INHSZ0("Invalid field or expression: "_F,1) Q
  1. S A=" S FIELD("""_V_""")=""N Y "_$$REPLACE^UTIL(X,"""","""""")_"""" D L
  1. S I=0 F S I=$O(X(I)) Q:'I S A=" S FIELD("""_V_""","_I_")="""_$$REPLACE^UTIL(X(I),"""","""""")_"""" D L
  1. S V1=$$VEXP^INHSZ51(V),A1="$S($D("_V1_")#2:"_V1_",1:$G(@INV@("""_V_""")))",A=" S FIELD("""_V_""",1)="""_$$REPLACE^UTIL(A1,"""","""""")_"""" D L
  1. S MCNT=MCNT+1,A=" S FIELD("""_V_""",0)="""_M_""",MDESC("_MCNT_")="" "_$$REPLACE^UTIL(F,"""","""""")_" = ""_"_A1_"_"" ("_$S(M="E":"Exact Match",1:"Null Matches anything")_")""" D L
  1. Q
  1. ;
  1. LOOK ;command used in REPEAT block to perform lookup
  1. I 'REPEAT D ERROR^INHSZ0("LOOK command only used within a REPEAT block in the LOOKUP section.",1) Q
  1. D DOIT Q
  1. ;
  1. PARAM ;Set Lookup parameter
  1. S LPARAM=$$CASECONV^UTIL($$LBTB^UTIL($P(LINE," ",2,999)),"U") I "NFL"'[LPARAM!($L(LPARAM)>1) D ERROR^INHSZ0("Invalid LOOKUP specifier.",1)
  1. Q
  1. ;