Add 'VA FileMan 22.0 Key and Index Tutorial Test File A6AKIT' into 'Infrastructure/FileMan/22.0/'
Date-Created: 2006-12-05 Date-Updated: 2006-12-05
This commit is contained in:
US DVA
OSEHR Agent
parent
f758d94bc2
commit
361177691e
|
|
@ -0,0 +1,363 @@
|
|||
Cache for OpenVMS/ALPHA V7.x^INT^FOR FILEMAN TUTORIAL^~Format=Cache.S~
|
||||
%RO on 04 Dec 2006 12:01 PM
|
||||
A6AKIT^INT^1^60143,64595^0
|
||||
A6AKIT ;SFISC/MKO-SET UP TEST FILE FOR KEY AND INDEX TUTORIAL ;4:06 PM 5 Mar 2001
|
||||
;;1.0;KEY AND INDEX TUTORIAL;Mar 1, 2001
|
||||
N A6AFL,A6AGL,A6ASFL
|
||||
I $G(DUZ(0))'="@" D Q
|
||||
. W $C(7),!,"You must be a programmer to run this utility."
|
||||
;
|
||||
D INIZE^DIEFU,HOME^%ZIS
|
||||
;
|
||||
;Get file name and number
|
||||
S A6AFL=$$FL Q:A6AFL<0
|
||||
;
|
||||
;If selected an existing file, ask whether to delete it first
|
||||
I '$P(A6AFL,U,3) D Q:A6AGL=""
|
||||
. S A6AGL=$G(^DIC(+A6AFL,0,"GL")) Q:A6AGL=""
|
||||
. I '$$ASKDEL(A6AFL) S A6AGL="" Q
|
||||
. D REP(A6AFL,A6AGL)
|
||||
;
|
||||
;Otherwise, this is a new file
|
||||
E S A6AGL=$$GL(A6AFL) Q:A6AGL=""
|
||||
;
|
||||
;Set DD and data
|
||||
S A6ASFL=+A6AFL_$E(".",+A6AFL'[".")_"02"
|
||||
D DD^A6AKIT1(+A6AFL,A6ASFL)
|
||||
D DATA^A6AKIT2(A6AGL,A6ASFL)
|
||||
;
|
||||
W !!,"File created: "_$P(A6AFL,U,2)_" (#"_+A6AFL_")"
|
||||
W !," Global root: "_A6AGL
|
||||
W !!,"DONE!!"
|
||||
Q
|
||||
;
|
||||
FL() ;Get file name and number
|
||||
N DA,DLAYGO,DIC,DILN,DTOUT,DUOUT,I,X,Y,Z
|
||||
;
|
||||
W !,"I am going to set up a test file for the FileMan V. 22.0 Key and Index"
|
||||
W !,"tutorial."
|
||||
W !!,"The tutorial assumes the name of the test file is ZZINDIVIDUAL and the"
|
||||
W !,"number of the test file is 662nnn, but you can choose any name and number"
|
||||
W !,"you wish.",!
|
||||
;
|
||||
S DLAYGO=1
|
||||
S DIC="^DIC(",DIC(0)="QEAXLI"
|
||||
S DIC("A")="Name of test file: "
|
||||
S DIC("B")="ZZINDIVIDUAL"
|
||||
S DIC("S")="I Y'<2 S DIFILE=+Y,DIAC=""DD"" D ^DIAC I %"
|
||||
S DIC("W")=$P($T(W),";;",2,999)
|
||||
D ^DIC
|
||||
Q Y
|
||||
W ;;W:$X>53 !?9 I Y-1.1,Y-.6,$D(^DIC(Y,0,"GL")),^("GL")'["[",$D(@(^("GL")_"0)")) S %=+$P(^(0),U,4) W ?40," ("_%_" entr"_$P("ies^y",U,%=1+1)_")"
|
||||
;
|
||||
GL(Y) ;Get global root of file
|
||||
Q:'$P(Y,U,3) $G(^DIC(+Y,0,"GL"))
|
||||
N %,DA,DG,DIC,DIE,DIK,DLAYGO,F,X,Z
|
||||
D DIE^DIB
|
||||
Q $G(DG)
|
||||
;
|
||||
ASKDEL(A6AFL) ;Ask whether to delete file
|
||||
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,A6ADEV,A6AMSG,DIERR
|
||||
;
|
||||
;Make sure this looks like the test file
|
||||
D
|
||||
. Q:'$D(^DD(+A6AFL,"B","AREA CODE",3.1))
|
||||
. Q:'$D(^DD(+A6AFL,"B","DATE CREATED",4.1))
|
||||
. Q:'$D(^DD(+A6AFL,"B","DOB",.03))
|
||||
. Q:'$D(^DD(+A6AFL,"B","EMAIL",2))
|
||||
. Q:'$D(^DD(+A6AFL,"B","LOCAL NUMBER",3.2))
|
||||
. Q:'$D(^DD(+A6AFL,"B","OLD PHONE NUMBER",3.4))
|
||||
. Q:'$D(^DD(+A6AFL,"B","PHONE NUMBER",3.3))
|
||||
. Q:'$D(^DD(+A6AFL,"B","SSN",.02))
|
||||
. S Y=1
|
||||
I '$G(Y) D Q 0
|
||||
. W !!,$C(7)_" The file you have selected doesn't look like the Key and Index Tutorial"
|
||||
. W !," test file. The A6AKIT utility cannot be used to delete it. Please use"
|
||||
. W !," FileMan's Edit File option on the Utility Functions menu to delete it,"
|
||||
. W !," or select a different file.",!
|
||||
;
|
||||
;Ask whether to delete the old file.
|
||||
S A6ADEV=$$GET1^DID(+A6AFL,"","","DEVELOPER","","A6AMSG")
|
||||
S:A6ADEV?." " A6ADEV="<unknown>"
|
||||
W !!," NOTE: You've selected an existing Key and Index Tutorial test file."
|
||||
W !!," File: "_$P(A6AFL,U,2)_" (#"_+A6AFL_")"
|
||||
W !," Created by: "_A6ADEV
|
||||
W !!," You can choose to delete it and replace it with the original version"
|
||||
W !," of the file."
|
||||
S DIR(0)="Y"
|
||||
S DIR("A")="Delete and replace "_$P(A6AFL,U,2)_" File (#"_+A6AFL_")"
|
||||
S DIR("B")="NO"
|
||||
S DIR("?",1)=" Answer 'YES' if you would like to delete the file, and replace it with"
|
||||
S DIR("?",2)=" the original version of the test file."
|
||||
S DIR("?",3)=""
|
||||
S DIR("?")=" Answer 'NO' to quit."
|
||||
W ! D ^DIR
|
||||
Q Y
|
||||
;
|
||||
REP(A6AFL,A6AGL) ;Replace file
|
||||
;Delete
|
||||
N %,DA,DIC,DLAYGO,DIU,X,Y,Z
|
||||
S DIU=+A6AFL,DIU(0)="DT"
|
||||
D EN^DIU2
|
||||
;
|
||||
;Create
|
||||
S DLAYGO=1
|
||||
S DIC="^DIC(",DIC(0)="QLXI"
|
||||
S X=$P(A6AFL,U,2),DINUM=+A6AFL
|
||||
D FILE^DICN
|
||||
;
|
||||
S $P(^DIC(+A6AFL,0),U,2)=+A6AFL,^("%A")=DUZ_U_DT,^(0,"GL")=A6AGL
|
||||
F %="DD","DEL","RD","WR","LAYGO","AUDIT" S ^DIC(+A6AFL,0,%)="@"
|
||||
S ^DD(+A6AFL,0)="FIELD^^0^0"
|
||||
S @(A6AGL_"0)")=$P(A6AFL,U,2)_U_+A6AFL
|
||||
Q
|
||||
;
|
||||
MODENT(A6AFILE) ;Establishes a starting point for
|
||||
;OLD PHONE NUMBER and PHONE NUMBER
|
||||
N A6AFDA,A6AIENS
|
||||
;
|
||||
;Lookup MODIFIED ENTRY
|
||||
S A6AIENS=$$FIND1^DIC(A6AFILE,"","QX","MODIFIED,ENTRY","B")_","
|
||||
I $G(A6AIENS)'>0 D Q
|
||||
. I $G(DIERR) D MSG^DIALOG() Q
|
||||
. I $P(A6AIENS,",")=0 W !,"MODIFIED,ENTRY not found."
|
||||
;
|
||||
S A6AFDA(A6AFILE,A6AIENS,3.1)=111
|
||||
S A6AFDA(A6AFILE,A6AIENS,3.2)="111-1111"
|
||||
D FILE^DIE("","A6AFDA") I $G(DIERR) D MSG^DIALOG() Q
|
||||
;
|
||||
S A6AFDA(A6AFILE,A6AIENS,3.1)=415
|
||||
S A6AFDA(A6AFILE,A6AIENS,3.2)="555-1234"
|
||||
D FILE^DIE("","A6AFDA") I $G(DIERR) D MSG^DIALOG() Q
|
||||
;
|
||||
D INQ(A6AFILE,+A6AIENS)
|
||||
Q
|
||||
;
|
||||
INQ(A6AFILE,A6AIEN) ;Inquire
|
||||
N A,D0,DK,S,Y,DIC,DA,DR,DIQ
|
||||
S DIC=$S($G(A6AFILE):$G(^DIC(A6AFILE,0,"GL")),1:$G(A6AFILE))
|
||||
Q:$G(DIC)=""
|
||||
S DA=+A6AIEN,DIQ(0)="R"
|
||||
D EN^DIQ
|
||||
Q
|
||||
|
||||
A6AKIT1^INT^1^60143,64595^0
|
||||
A6AKIT1 ;SFISC/MKO-DD FOR ZZINDIVIDUAL FILE ;11:10 AM 1 Mar 2001
|
||||
;;1.0;KEY AND INDEX TUTORIAL;Mar 1, 2001
|
||||
DD(A6AFIL,A6ASFL) ;Build DD
|
||||
N I,X,Y,Z
|
||||
;
|
||||
F I=1:2 S X=$T(Q+I) Q:X="" D
|
||||
. S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999)
|
||||
. S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99)
|
||||
. S:$A(Y)=61 Y=$E(Y,2,999)
|
||||
. F Q:Y'["A6ASFL" S Y=$P(Y,"A6ASFL")_A6ASFL_$P(Y,"A6ASFL",2,999)
|
||||
. F Q:Y'["A6AFIL" S Y=$P(Y,"A6AFIL")_A6AFIL_$P(Y,"A6AFIL",2,999)
|
||||
. S @X=Y
|
||||
N DA,DIC,DIK
|
||||
S DIK="^DD("_A6AFIL_",",DA(1)=A6AFIL D IXALL^DIK K DIK,DA
|
||||
S DIK="^DD("_A6ASFL_",",DA(1)=A6ASFL D IXALL^DIK K DIK,DA
|
||||
Q Q
|
||||
;;^DD(A6AFIL,.01,0)
|
||||
;;=NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
|
||||
;;^DD(A6AFIL,.01,1,0)
|
||||
;;=^.1
|
||||
;;^DD(A6AFIL,.01,1,1,0)
|
||||
;;=A6AFIL^B
|
||||
;;^DD(A6AFIL,.01,1,1,1)
|
||||
;;=S ^DIZ(A6AFIL,"B",$E(X,1,30),DA)=""
|
||||
;;^DD(A6AFIL,.01,1,1,2)
|
||||
;;=K ^DIZ(A6AFIL,"B",$E(X,1,30),DA)
|
||||
;;^DD(A6AFIL,.01,3)
|
||||
;;=Answer must be 3-30 characters in length.
|
||||
;;^DD(A6AFIL,.02,0)
|
||||
;;=SSN^F^^0;2^K:$L(X)>9!($L(X)<9)!'(X?9N) X
|
||||
;;^DD(A6AFIL,.02,3)
|
||||
;;=Answer must be 9 characters in length.
|
||||
;;^DD(A6AFIL,.03,0)
|
||||
;;=DOB^D^^0;3^S %DT="EX" D ^%DT S X=Y K:Y<1 X
|
||||
;;^DD(A6AFIL,2,0)
|
||||
;;=EMAIL^A6ASFL^^2;0
|
||||
;;^DD(A6AFIL,3.1,0)
|
||||
;;=AREA CODE^NJ3,0^^3;1^K:+X'=X!(X>999)!(X<100)!(X?.E1"."1N.N) X
|
||||
;;^DD(A6AFIL,3.1,3)
|
||||
;;=Type a Number between 100 and 999, 0 Decimal Digits
|
||||
;;^DD(A6AFIL,3.2,0)
|
||||
;;=LOCAL NUMBER^F^^3;2^K:$L(X)>8!($L(X)<8)!'(X?3N1"-"4N) X
|
||||
;;^DD(A6AFIL,3.2,3)
|
||||
;;=Answer must be 8 characters in length.
|
||||
;;^DD(A6AFIL,3.3,0)
|
||||
;;=PHONE NUMBER^F^^3;3^K:$L(X)>15!($L(X)<1) X
|
||||
;;^DD(A6AFIL,3.3,3)
|
||||
;;=Answer must be 1-15 characters in length.
|
||||
;;^DD(A6AFIL,3.4,0)
|
||||
;;=OLD PHONE NUMBER^F^^3;4^K:$L(X)>15!($L(X)<1) X
|
||||
;;^DD(A6AFIL,3.4,3)
|
||||
;;=Answer must be 1-15 characters in length.
|
||||
;;^DD(A6AFIL,4.1,0)
|
||||
;;=DATE CREATED^D^^4;1^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X
|
||||
;;^DD(A6ASFL,0)
|
||||
;;=EMAIL SUB-FIELD^^1^2
|
||||
;;^DD(A6ASFL,0,"NM","EMAIL")
|
||||
;;=
|
||||
;;^DD(A6ASFL,0,"UP")
|
||||
;;=A6AFIL
|
||||
;;^DD(A6ASFL,.01,0)
|
||||
;;=EMAIL NAME^MF^^0;1^K:$L(X)>20!($L(X)<1) X
|
||||
;;^DD(A6ASFL,.01,1,0)
|
||||
;;=^.1
|
||||
;;^DD(A6ASFL,.01,1,1,0)
|
||||
;;=A6ASFL^B
|
||||
;;^DD(A6ASFL,.01,1,1,1)
|
||||
;;=S ^DIZ(A6AFIL,DA(1),2,"B",$E(X,1,30),DA)=""
|
||||
;;^DD(A6ASFL,.01,1,1,2)
|
||||
;;=K ^DIZ(A6AFIL,DA(1),2,"B",$E(X,1,30),DA)
|
||||
;;^DD(A6ASFL,.01,3)
|
||||
;;=Answer must be 1-20 characters in length.
|
||||
;;^DD(A6ASFL,1,0)
|
||||
;;=EMAIL DOMAIN^F^^0;2^K:$L(X)>20!($L(X)<1) X
|
||||
;;^DD(A6ASFL,1,3)
|
||||
;;=Answer must be 1-20 characters in length.
|
||||
|
||||
A6AKIT2^INT^1^60186,40400^
|
||||
A6AKIT2 ;SFISC/MKO-DATA FOR ZZINDIVIDUAL FILE ;11:13 AM 13 Oct 2005
|
||||
;;1.0;KEY AND INDEX TUTORIAL;Mar 1, 2001
|
||||
DATA(A6AGL,A6ASFL) ;Set data
|
||||
N A6AGBL,X,Y,Z
|
||||
S A6AGBL=$$CREF^DILF(A6AGL)
|
||||
F I=1:2 S X=$T(ENTRY+I) Q:X="" D
|
||||
. S Y=$E($T(ENTRY+I+1),5,999),X=$E(X,4,999)
|
||||
. F Q:Y'["A6ASFL" S Y=$P(Y,"A6ASFL")_A6ASFL_$P(Y,"A6ASFL",2,999)
|
||||
. S @X=Y
|
||||
N DA,DIC,DIK S DIK=A6AGL D IXALL^DIK
|
||||
Q
|
||||
ENTRY ;
|
||||
;;@A6AGBL@(1,0)
|
||||
;;=FMPATIENT,ONE^000221111^2450520
|
||||
;;@A6AGBL@(1,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(1,2,1,0)
|
||||
;;=rc^aaa.bbb.com
|
||||
;;@A6AGBL@(1,2,2,0)
|
||||
;;=rose^xxx.yyy.com
|
||||
;;@A6AGBL@(1,3)
|
||||
;;=206^555-4112
|
||||
;;@A6AGBL@(2,0)
|
||||
;;=FMPATIENT,TWO^666443333^2320205
|
||||
;;@A6AGBL@(2,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(2,2,1,0)
|
||||
;;=jasmine.geiser^aaa.bbb.com
|
||||
;;@A6AGBL@(2,2,2,0)
|
||||
;;=jasmine^xxx.yyy.com
|
||||
;;@A6AGBL@(2,3)
|
||||
;;=206^555-8257
|
||||
;;@A6AGBL@(3,0)
|
||||
;;=FMPATIENT,THREE^666776666^2590714
|
||||
;;@A6AGBL@(3,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(3,2,1,0)
|
||||
;;=herb^abc.def.com
|
||||
;;@A6AGBL@(3,2,2,0)
|
||||
;;=hwaters^abc.def.com
|
||||
;;@A6AGBL@(3,3)
|
||||
;;=406^555-5834
|
||||
;;@A6AGBL@(4,0)
|
||||
;;=FMPATIENT,FOUR^666223333^2691123
|
||||
;;@A6AGBL@(4,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(4,2,1,0)
|
||||
;;=mlake^xxx.yyy.com
|
||||
;;@A6AGBL@(4,2,2,0)
|
||||
;;=marigold^aaa.bbb.com
|
||||
;;@A6AGBL@(4,3)
|
||||
;;=503^555-3612
|
||||
;;@A6AGBL@(5,0)
|
||||
;;=FMPATIENT,FIVE^666654321^2710227
|
||||
;;@A6AGBL@(5,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(5,2,1,0)
|
||||
;;=dill^abc.def.com
|
||||
;;@A6AGBL@(5,2,2,0)
|
||||
;;=dtide^xxx.yyy.com
|
||||
;;@A6AGBL@(5,3)
|
||||
;;=505^555-5939
|
||||
;;@A6AGBL@(6,0)
|
||||
;;=FMPATIENT,SIX^666889999^2550602
|
||||
;;@A6AGBL@(6,2,0)
|
||||
;;=^A6ASFL^1^1
|
||||
;;@A6AGBL@(6,2,1,0)
|
||||
;;=sagebrooks^aaa.bbb.com
|
||||
;;@A6AGBL@(6,3)
|
||||
;;=307^555-4680
|
||||
;;@A6AGBL@(7,0)
|
||||
;;=FMPATIENT,SEVEN^666678901^2480811
|
||||
;;@A6AGBL@(7,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(7,2,1,0)
|
||||
;;=hazel.frost^abc.def.com
|
||||
;;@A6AGBL@(7,2,2,0)
|
||||
;;=hazel^abc.def.com
|
||||
;;@A6AGBL@(7,3)
|
||||
;;=503^555-6874
|
||||
;;@A6AGBL@(8,0)
|
||||
;;=FMPATIENT,EIGHT^666891234^2730926
|
||||
;;@A6AGBL@(8,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(8,2,1,0)
|
||||
;;=saffron^aaa.bbb.com
|
||||
;;@A6AGBL@(8,2,2,0)
|
||||
;;=sripple^abc.def.com
|
||||
;;@A6AGBL@(8,3)
|
||||
;;=503^555-7555^^
|
||||
;;@A6AGBL@(9,0)
|
||||
;;=FMPATIENT,NINE^666345678^2191031
|
||||
;;@A6AGBL@(9,2,0)
|
||||
;;=^A6ASFL^1^1
|
||||
;;@A6AGBL@(9,2,1,0)
|
||||
;;=ginger^aaa.bbb.com
|
||||
;;@A6AGBL@(9,3)
|
||||
;;=208^555-8097
|
||||
;;@A6AGBL@(10,0)
|
||||
;;=FMPATIENT,TEN^666432123^2380409
|
||||
;;@A6AGBL@(10,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(10,2,1,0)
|
||||
;;=periwinkle^abc.def.com
|
||||
;;@A6AGBL@(10,2,2,0)
|
||||
;;=pwells^xxx.yyy.com
|
||||
;;@A6AGBL@(10,3)
|
||||
;;=415^555-5938
|
||||
;;@A6AGBL@(11,0)
|
||||
;;=FMPATIENT,ELEVEN^666765432^2700321
|
||||
;;@A6AGBL@(11,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(11,2,1,0)
|
||||
;;=chervil^xxx.yyy.com
|
||||
;;@A6AGBL@(11,2,2,0)
|
||||
;;=cpuddles^abc.def.com
|
||||
;;@A6AGBL@(11,3)
|
||||
;;=907^555-7584
|
||||
;;@A6AGBL@(12,0)
|
||||
;;=FMPATIENT,TWELVE^666996666^2470522
|
||||
;;@A6AGBL@(12,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(12,2,1,0)
|
||||
;;=basil^abc.def.com
|
||||
;;@A6AGBL@(12,2,2,0)
|
||||
;;=bsnow^xxx.yyy.com
|
||||
;;@A6AGBL@(12,3)
|
||||
;;=503^555-9573
|
||||
;;@A6AGBL@(13,0)
|
||||
;;=FMPATIENT,THIRTEEN^666567890^2450520
|
||||
;;@A6AGBL@(13,2,0)
|
||||
;;=^A6ASFL^2^2
|
||||
;;@A6AGBL@(13,2,1,0)
|
||||
;;=holly^abc.def.com
|
||||
;;@A6AGBL@(13,2,2,0)
|
||||
;;=hollyrivers^xxx.yyy.com
|
||||
;;@A6AGBL@(13,3)
|
||||
;;=509^555-7969
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue