| [613] | 1 | DII ;SFISC/GFT,XAK,TKW-OPTION RDR, INQUIRY ;5:21 AM 15 Mar 2005
|
|---|
| 2 | V ;;22.0;VA FileMan;**64,81,143**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | W !!,"VA FileMan "_$P($T(V),";",3),!
|
|---|
| 6 | ;
|
|---|
| 7 | ;If not Stand Alone make sure DUZ is defined ;22*143
|
|---|
| 8 | I '+$G(DUZ),$D(^VA(200,0))#2 D I '+$G(DUZ) W $C(7),!,$$EZBLD^DIALOG(7005),! Q
|
|---|
| 9 | . ;If ASKDUZ^XUP available, use it first
|
|---|
| 10 | . I $L($T(ASKDUZ^XUP)) N DIR,DIRUT,DUOUT,DTOUT D Q:($D(DUOUT)!$D(DTOUT))
|
|---|
| 11 | .. N XUEOFF,XUEON,DIDUZ
|
|---|
| 12 | .. I '$D(^%ZOSF("EOFF")) Q
|
|---|
| 13 | .. I '$D(^%ZOSF("EON")) Q
|
|---|
| 14 | .. W !,"Your Identity(DUZ) is 0(zero).",!,"Please identify yourself.",!
|
|---|
| 15 | .. S:$G(DUZ(0))]"" DIDUZ=DUZ(0)
|
|---|
| 16 | .. S XUEOFF=^%ZOSF("EOFF"),XUEON=^%ZOSF("EON")
|
|---|
| 17 | .. D ASKDUZ^XUP ;IA #4596
|
|---|
| 18 | .. S:$G(DIDUZ)]"" DUZ(0)=DIDUZ
|
|---|
| 19 | .. Q
|
|---|
| 20 | . ;If DUZ is still undefined as last resort call DIC
|
|---|
| 21 | . I '+$G(DUZ) D Q
|
|---|
| 22 | .. N DIC,DTOUT,DUOUT,DIDUZ
|
|---|
| 23 | .. S:$G(DUZ(0))]"" DIDUZ=DUZ(0)
|
|---|
| 24 | .. W $C(7),!,"Your Identity(DUZ) is still 0(zero).",!,"You need to identify yourself!",!
|
|---|
| 25 | .. S DUZ=0,DIC=200,DIC(0)="AEFNQZ",DIC("A")="New Person?: "
|
|---|
| 26 | .. ;Can't be POSTMASTER or SHARED MAIL and have an ACCESS CODE
|
|---|
| 27 | .. S DIC("S")="I ((+Y'<1)&($P(^(0),""^"",3)]""""))"
|
|---|
| 28 | .. D ^DIC
|
|---|
| 29 | .. I +Y'>1 Q
|
|---|
| 30 | .. S DUZ=+Y
|
|---|
| 31 | .. S DUZ(0)=$P(^VA(200,DUZ,0),U,4)
|
|---|
| 32 | .. S:$G(DIDUZ)]"" DUZ(0)=DIDUZ
|
|---|
| 33 | .. Q
|
|---|
| 34 | . Q
|
|---|
| 35 | ;
|
|---|
| 36 | NOKL D DT^DICRW,OS S DIK="^DOPT(""DII""," G F:$D(^DOPT("DII",9)) S ^(0)="OPTION^1.01^" F I=1:1 S X=$E($T(F+I),4,99) Q:X="" S ^DOPT("DII",I,0)=X
|
|---|
| 37 | D IXALL^DIK
|
|---|
| 38 | F S DIC=DIK,DIC(0)="AEQZ" D ^DIC K DIC,DIK G Q:Y<0 S X=$P(Y(0),U,2,99) K Y D @X W !!! D Q G NOKL
|
|---|
| 39 | ;;ENTER OR EDIT FILE ENTRIES^^DIB
|
|---|
| 40 | ;;PRINT FILE ENTRIES^^DIP
|
|---|
| 41 | ;;SEARCH FILE ENTRIES^^DIS
|
|---|
| 42 | ;;MODIFY FILE ATTRIBUTES^^DICATT
|
|---|
| 43 | ;;INQUIRE TO FILE ENTRIES^INQ^DII
|
|---|
| 44 | ;;UTILITY FUNCTIONS^^DIU
|
|---|
| 45 | ;;OTHER OPTIONS^^DII1
|
|---|
| 46 | ;;DATA DICTIONARY UTILITIES^^DDU
|
|---|
| 47 | ;;TRANSFER ENTRIES^^DIT
|
|---|
| 48 | ;
|
|---|
| 49 | Q D Q^DIB,Q^DICATT2,Q^DIARB
|
|---|
| 50 | K DRK,DIL,DIS,DK,DIACD,DIQ,DX,DQI,DISYS,DHIT,%X,%Y,%,DXS,Q,DIAR
|
|---|
| 51 | K A0,D9,DNP,DCC,DIJ,DP,DM,DQ,DICATT,DIFLD,D0,DIEL,DL,DC,DU,DIP
|
|---|
| 52 | K DH,DIYS,DINS,DIPT,DHD,DCL,DPP,DPQ,DALL,DIRUT,DIROUT,DUOUT,DTOUT
|
|---|
| 53 | Q
|
|---|
| 54 | INQ ;
|
|---|
| 55 | W !! D ^DICRW Q:'$D(DIC) S DI=DIC,DPP(1)=+Y_"^^^@",DK=+Y I $D(DICS) S DICSS=DICS
|
|---|
| 56 | B K ^UTILITY($J),^(U,$J),DIC,DIQ,DISV,DIBT,DICS S DIC=DI,DIC(0)="AEQM",DIK=0
|
|---|
| 57 | R D ^DIC I Y>0 S DIK=DIK+1,^UTILITY(U,$J,DIK,+Y)="",DIC("A")="ANOTHER ONE: " G R
|
|---|
| 58 | S G Q^DIP:'DIK!(X=U) G:DIK'>3 O
|
|---|
| 59 | D K DIRUT,DIROUT
|
|---|
| 60 | . N DIK,DI,DICSS,DX D S2^DIBT1 Q
|
|---|
| 61 | G:$D(DTOUT)!($D(DUOUT)) Q^DIP G:X="" O G:Y<0 S
|
|---|
| 62 | F X=1:1:DIK S ^DIBT(+Y,1,+$O(^UTILITY(U,$J,X,0)))=""
|
|---|
| 63 | S ^DIBT(+Y,"QR")=DT_U_DIK
|
|---|
| 64 | O K DIC G Q^DIP:$D(DTOUT) S DIC=DI,%=1
|
|---|
| 65 | W !,"STANDARD CAPTIONED OUTPUT" D YN^DICN G Q^DIP:%<0
|
|---|
| 66 | I '% W !?5,"Answer 'N' to create a formatted display as in the Print Option." G O
|
|---|
| 67 | I %=2 S L=1,Q="""",DPP=1,DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2" S:$D(DICSS) DICS=DICSS G N^DIP1
|
|---|
| 68 | D C G:$D(DIRUT) Q
|
|---|
| 69 | S IOP="HOME" D ^%ZIS I $D(DICSS) S DICS=DICSS
|
|---|
| 70 | DIQ N S S S=1 F DIK=1:1:DIK S DA=+$O(^UTILITY(U,$J,DIK,0)) W ! D:DIK>1 LF^DIQ Q:'S D CAPTION^DIQ(DK,DA,DIQ(0)) G:'S Q S S=S+2
|
|---|
| 71 | W !! Q:$D(DTOUT) G B
|
|---|
| 72 | ;
|
|---|
| 73 | P G Q^DI
|
|---|
| 74 | ;
|
|---|
| 75 | OS I $D(^%ZOSF("OS"))#2 S DISYS=+$P(^("OS"),"^",2) Q:DISYS>0
|
|---|
| 76 | S DISYS=$S($D(^DD("OS"))#2:^("OS"),1:100)
|
|---|
| 77 | Q
|
|---|
| 78 | AUD S DIACD=DIQ(0),DIQ(0)="C",DIQ=DA
|
|---|
| 79 | F DA=0:0 S DA=$O(^DIA(DK,"B",DIQ,DA)) Q:DA'>0 S DIC="^DIA("_DK_",",E="N<0",N=-1,DD=1.1,DIA=DK D GUY^DIQ Q:'S W !
|
|---|
| 80 | S DIQ(0)=DIACD Q
|
|---|
| 81 | ;
|
|---|
| 82 | C ;called from ^DIP21
|
|---|
| 83 | N DIR,I,L,Y,X,DITXT
|
|---|
| 84 | D BLD^DIALOG(7004,"","","DIR") S DITXT="" D S DITXT=DITXT_DIR
|
|---|
| 85 | . F I=1:1 Q:$G(DIR(I))="" S DITXT=DITXT_DIR(I)
|
|---|
| 86 | . Q
|
|---|
| 87 | K DIR S DIR(0)="SMB^"_DITXT,DIR("B")=$P($P(DITXT,":",2)," ",1),DIR("A")=$$EZBLD^DIALOG(8002)
|
|---|
| 88 | D ^DIR Q:$D(DIRUT)
|
|---|
| 89 | F I=1:1 S X=$P($P(DITXT,";",I),":") Q:X="" I X=Y S DIQ(0)=$S(I=2:"C",I=3:"R",I=4:"CR",1:"") Q
|
|---|
| 90 | I X'=Y S DIRUT=1 Q
|
|---|
| 91 | I $D(^DIA(DK)) S DIR(0)="Y",DIR("A")="DISPLAY AUDIT TRAIL",DIR("B")="No",DIR("?")="Answer 'Y' to display the audit trail for each Entry." D ^DIR Q:$D(DIRUT) S:Y=1 DIQ(0)=DIQ(0)_"A"
|
|---|
| 92 | Q
|
|---|
| 93 | ;7004 N:No;Y:Yes;R:Record Number;B:Both Computed and Number
|
|---|
| 94 | ;7005 You must have a valid DUZ! ;22*143
|
|---|
| 95 | ;8002 Include COMPUTED fields
|
|---|
