DII ;SFISC/GFT,XAK,TKW-OPTION RDR, INQUIRY ;5:21 AM 15 Mar 2005
V ;;22.0;VA FileMan;**64,81,143**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
W !!,"VA FileMan "_$P($T(V),";",3),!
;
;If not Stand Alone make sure DUZ is defined ;22*143
I '+$G(DUZ),$D(^VA(200,0))#2 D I '+$G(DUZ) W $C(7),!,$$EZBLD^DIALOG(7005),! Q
. ;If ASKDUZ^XUP available, use it first
. I $L($T(ASKDUZ^XUP)) N DIR,DIRUT,DUOUT,DTOUT D Q:($D(DUOUT)!$D(DTOUT))
.. N XUEOFF,XUEON,DIDUZ
.. I '$D(^%ZOSF("EOFF")) Q
.. I '$D(^%ZOSF("EON")) Q
.. W !,"Your Identity(DUZ) is 0(zero).",!,"Please identify yourself.",!
.. S:$G(DUZ(0))]"" DIDUZ=DUZ(0)
.. S XUEOFF=^%ZOSF("EOFF"),XUEON=^%ZOSF("EON")
.. D ASKDUZ^XUP ;IA #4596
.. S:$G(DIDUZ)]"" DUZ(0)=DIDUZ
.. Q
. ;If DUZ is still undefined as last resort call DIC
. I '+$G(DUZ) D Q
.. N DIC,DTOUT,DUOUT,DIDUZ
.. S:$G(DUZ(0))]"" DIDUZ=DUZ(0)
.. W $C(7),!,"Your Identity(DUZ) is still 0(zero).",!,"You need to identify yourself!",!
.. S DUZ=0,DIC=200,DIC(0)="AEFNQZ",DIC("A")="New Person?: "
.. ;Can't be POSTMASTER or SHARED MAIL and have an ACCESS CODE
.. S DIC("S")="I ((+Y'<1)&($P(^(0),""^"",3)]""""))"
.. D ^DIC
.. I +Y'>1 Q
.. S DUZ=+Y
.. S DUZ(0)=$P(^VA(200,DUZ,0),U,4)
.. S:$G(DIDUZ)]"" DUZ(0)=DIDUZ
.. Q
. Q
;
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
D IXALL^DIK
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
;;ENTER OR EDIT FILE ENTRIES^^DIB
;;PRINT FILE ENTRIES^^DIP
;;SEARCH FILE ENTRIES^^DIS
;;MODIFY FILE ATTRIBUTES^^DICATT
;;INQUIRE TO FILE ENTRIES^INQ^DII
;;UTILITY FUNCTIONS^^DIU
;;OTHER OPTIONS^^DII1
;;DATA DICTIONARY UTILITIES^^DDU
;;TRANSFER ENTRIES^^DIT
;
Q D Q^DIB,Q^DICATT2,Q^DIARB
K DRK,DIL,DIS,DK,DIACD,DIQ,DX,DQI,DISYS,DHIT,%X,%Y,%,DXS,Q,DIAR
K A0,D9,DNP,DCC,DIJ,DP,DM,DQ,DICATT,DIFLD,D0,DIEL,DL,DC,DU,DIP
K DH,DIYS,DINS,DIPT,DHD,DCL,DPP,DPQ,DALL,DIRUT,DIROUT,DUOUT,DTOUT
Q
INQ ;
W !! D ^DICRW Q:'$D(DIC) S DI=DIC,DPP(1)=+Y_"^^^@",DK=+Y I $D(DICS) S DICSS=DICS
B K ^UTILITY($J),^(U,$J),DIC,DIQ,DISV,DIBT,DICS S DIC=DI,DIC(0)="AEQM",DIK=0
R D ^DIC I Y>0 S DIK=DIK+1,^UTILITY(U,$J,DIK,+Y)="",DIC("A")="ANOTHER ONE: " G R
S G Q^DIP:'DIK!(X=U) G:DIK'>3 O
D K DIRUT,DIROUT
. N DIK,DI,DICSS,DX D S2^DIBT1 Q
G:$D(DTOUT)!($D(DUOUT)) Q^DIP G:X="" O G:Y<0 S
F X=1:1:DIK S ^DIBT(+Y,1,+$O(^UTILITY(U,$J,X,0)))=""
S ^DIBT(+Y,"QR")=DT_U_DIK
O K DIC G Q^DIP:$D(DTOUT) S DIC=DI,%=1
W !,"STANDARD CAPTIONED OUTPUT" D YN^DICN G Q^DIP:%<0
I '% W !?5,"Answer 'N' to create a formatted display as in the Print Option." G O
I %=2 S L=1,Q="""",DPP=1,DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2" S:$D(DICSS) DICS=DICSS G N^DIP1
D C G:$D(DIRUT) Q
S IOP="HOME" D ^%ZIS I $D(DICSS) S DICS=DICSS
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
W !! Q:$D(DTOUT) G B
;
P G Q^DI
;
OS I $D(^%ZOSF("OS"))#2 S DISYS=+$P(^("OS"),"^",2) Q:DISYS>0
S DISYS=$S($D(^DD("OS"))#2:^("OS"),1:100)
Q
AUD S DIACD=DIQ(0),DIQ(0)="C",DIQ=DA
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 !
S DIQ(0)=DIACD Q
;
C ;called from ^DIP21
N DIR,I,L,Y,X,DITXT
D BLD^DIALOG(7004,"","","DIR") S DITXT="" D S DITXT=DITXT_DIR
. F I=1:1 Q:$G(DIR(I))="" S DITXT=DITXT_DIR(I)
. Q
K DIR S DIR(0)="SMB^"_DITXT,DIR("B")=$P($P(DITXT,":",2)," ",1),DIR("A")=$$EZBLD^DIALOG(8002)
D ^DIR Q:$D(DIRUT)
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
I X'=Y S DIRUT=1 Q
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"
Q
;7004 N:No;Y:Yes;R:Record Number;B:Both Computed and Number
;7005 You must have a valid DUZ! ;22*143
;8002 Include COMPUTED fields
DII ;SFISC/GFT,XAK,TKW-OPTION RDR, INQUIRY ;5:21 AM 15 Mar 2005
V ;;22.0;VA FileMan;**64,81,143**;Mar 30, 1999
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 WRITE !!,"VA FileMan "_$PIECE($TEXT(V),";",3),!
+4 ;
+5 ;If not Stand Alone make sure DUZ is defined ;22*143
+6 IF '+$GET(DUZ)
IF $DATA(^VA(200,0))#2
Begin DoDot:1
+7 ;If ASKDUZ^XUP available, use it first
+8 IF $LENGTH($TEXT(ASKDUZ^XUP))
NEW DIR,DIRUT,DUOUT,DTOUT
Begin DoDot:2
+9 NEW XUEOFF,XUEON,DIDUZ
+10 IF '$DATA(^%ZOSF("EOFF"))
QUIT
+11 IF '$DATA(^%ZOSF("EON"))
QUIT
+12 WRITE !,"Your Identity(DUZ) is 0(zero).",!,"Please identify yourself.",!
+13 IF $GET(DUZ(0))]""
SET DIDUZ=DUZ(0)
+14 SET XUEOFF=^%ZOSF("EOFF")
SET XUEON=^%ZOSF("EON")
+15 ;IA #4596
DO ASKDUZ^XUP
+16 IF $GET(DIDUZ)]""
SET DUZ(0)=DIDUZ
+17 QUIT
End DoDot:2
IF ($DATA(DUOUT)!$DATA(DTOUT))
QUIT
+18 ;If DUZ is still undefined as last resort call DIC
+19 IF '+$GET(DUZ)
Begin DoDot:2
+20 NEW DIC,DTOUT,DUOUT,DIDUZ
+21 IF $GET(DUZ(0))]""
SET DIDUZ=DUZ(0)
+22 WRITE $CHAR(7),!,"Your Identity(DUZ) is still 0(zero).",!,"You need to identify yourself!",!
+23 SET DUZ=0
SET DIC=200
SET DIC(0)="AEFNQZ"
SET DIC("A")="New Person?: "
+24 ;Can't be POSTMASTER or SHARED MAIL and have an ACCESS CODE
+25 SET DIC("S")="I ((+Y'<1)&($P(^(0),""^"",3)]""""))"
+26 DO ^DIC
+27 IF +Y'>1
QUIT
+28 SET DUZ=+Y
+29 SET DUZ(0)=$PIECE(^VA(200,DUZ,0),U,4)
+30 IF $GET(DIDUZ)]""
SET DUZ(0)=DIDUZ
+31 QUIT
End DoDot:2
QUIT
+32 QUIT
End DoDot:1
IF '+$GET(DUZ)
WRITE $CHAR(7),!,$$EZBLD^DIALOG(7005),!
QUIT
+33 ;
NOKL DO DT^DICRW
DO OS
SET DIK="^DOPT(""DII"","
IF $DATA(^DOPT("DII",9))
GOTO F
SET ^(0)="OPTION^1.01^"
FOR I=1:1
SET X=$EXTRACT($TEXT(F+I),4,99)
IF X=""
QUIT
SET ^DOPT("DII",I,0)=X
+1 DO IXALL^DIK
F SET DIC=DIK
SET DIC(0)="AEQZ"
DO ^DIC
KILL DIC,DIK
IF Y<0
GOTO Q
SET X=$PIECE(Y(0),U,2,99)
KILL Y
DO @X
WRITE !!!
DO Q
GOTO NOKL
+1 ;;ENTER OR EDIT FILE ENTRIES^^DIB
+2 ;;PRINT FILE ENTRIES^^DIP
+3 ;;SEARCH FILE ENTRIES^^DIS
+4 ;;MODIFY FILE ATTRIBUTES^^DICATT
+5 ;;INQUIRE TO FILE ENTRIES^INQ^DII
+6 ;;UTILITY FUNCTIONS^^DIU
+7 ;;OTHER OPTIONS^^DII1
+8 ;;DATA DICTIONARY UTILITIES^^DDU
+9 ;;TRANSFER ENTRIES^^DIT
+10 ;
Q DO Q^DIB
DO Q^DICATT2
DO Q^DIARB
+1 KILL DRK,DIL,DIS,DK,DIACD,DIQ,DX,DQI,DISYS,DHIT,%X,%Y,%,DXS,Q,DIAR
+2 KILL A0,D9,DNP,DCC,DIJ,DP,DM,DQ,DICATT,DIFLD,D0,DIEL,DL,DC,DU,DIP
+3 KILL DH,DIYS,DINS,DIPT,DHD,DCL,DPP,DPQ,DALL,DIRUT,DIROUT,DUOUT,DTOUT
+4 QUIT
INQ ;
+1 WRITE !!
DO ^DICRW
IF '$DATA(DIC)
QUIT
SET DI=DIC
SET DPP(1)=+Y_"^^^@"
SET DK=+Y
IF $DATA(DICS)
SET DICSS=DICS
B KILL ^UTILITY($JOB),^(U,$JOB),DIC,DIQ,DISV,DIBT,DICS
SET DIC=DI
SET DIC(0)="AEQM"
SET DIK=0
R DO ^DIC
IF Y>0
SET DIK=DIK+1
SET ^UTILITY(U,$JOB,DIK,+Y)=""
SET DIC("A")="ANOTHER ONE: "
GOTO R
S IF 'DIK!(X=U)
GOTO Q^DIP
IF DIK'>3
GOTO O
+1 Begin DoDot:1
+2 NEW DIK,DI,DICSS,DX
DO S2^DIBT1
QUIT
End DoDot:1
KILL DIRUT,DIROUT
+3 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q^DIP
IF X=""
GOTO O
IF Y<0
GOTO S
+4 FOR X=1:1:DIK
SET ^DIBT(+Y,1,+$ORDER(^UTILITY(U,$JOB,X,0)))=""
+5 SET ^DIBT(+Y,"QR")=DT_U_DIK
O KILL DIC
IF $DATA(DTOUT)
GOTO Q^DIP
SET DIC=DI
SET %=1
+1 WRITE !,"STANDARD CAPTIONED OUTPUT"
DO YN^DICN
IF %<0
GOTO Q^DIP
+2 IF '%
WRITE !?5,"Answer 'N' to create a formatted display as in the Print Option."
GOTO O
+3 IF %=2
SET L=1
SET Q=""""
SET DPP=1
SET DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2"
IF $DATA(DICSS)
SET DICS=DICSS
GOTO N^DIP1
+4 DO C
IF $DATA(DIRUT)
GOTO Q
+5 SET IOP="HOME"
DO ^%ZIS
IF $DATA(DICSS)
SET DICS=DICSS
DIQ NEW S
SET S=1
FOR DIK=1:1:DIK
SET DA=+$ORDER(^UTILITY(U,$JOB,DIK,0))
WRITE !
IF DIK>1
DO LF^DIQ
IF 'S
QUIT
DO CAPTION^DIQ(DK,DA,DIQ(0))
IF 'S
GOTO Q
SET S=S+2
+1 WRITE !!
IF $DATA(DTOUT)
QUIT
GOTO B
+2 ;
P GOTO Q^DI
+1 ;
OS IF $DATA(^%ZOSF("OS"))#2
SET DISYS=+$PIECE(^("OS"),"^",2)
IF DISYS>0
QUIT
+1 SET DISYS=$SELECT($DATA(^DD("OS"))#2:^("OS"),1:100)
+2 QUIT
AUD SET DIACD=DIQ(0)
SET DIQ(0)="C"
SET DIQ=DA
+1 FOR DA=0:0
SET DA=$ORDER(^DIA(DK,"B",DIQ,DA))
IF DA'>0
QUIT
SET DIC="^DIA("_DK_","
SET E="N<0"
SET N=-1
SET DD=1.1
SET DIA=DK
DO GUY^DIQ
IF 'S
QUIT
WRITE !
+2 SET DIQ(0)=DIACD
QUIT
+3 ;
C ;called from ^DIP21
+1 NEW DIR,I,L,Y,X,DITXT
+2 DO BLD^DIALOG(7004,"","","DIR")
SET DITXT=""
Begin DoDot:1
+3 FOR I=1:1
IF $GET(DIR(I))=""
QUIT
SET DITXT=DITXT_DIR(I)
+4 QUIT
End DoDot:1
SET DITXT=DITXT_DIR
+5 KILL DIR
SET DIR(0)="SMB^"_DITXT
SET DIR("B")=$PIECE($PIECE(DITXT,":",2)," ",1)
SET DIR("A")=$$EZBLD^DIALOG(8002)
+6 DO ^DIR
IF $DATA(DIRUT)
QUIT
+7 FOR I=1:1
SET X=$PIECE($PIECE(DITXT,";",I),":")
IF X=""
QUIT
IF X=Y
SET DIQ(0)=$SELECT(I=2:"C",I=3:"R",I=4:"CR",1:"")
QUIT
+8 IF X'=Y
SET DIRUT=1
QUIT
+9 IF $DATA(^DIA(DK))
SET DIR(0)="Y"
SET DIR("A")="DISPLAY AUDIT TRAIL"
SET DIR("B")="No"
SET DIR("?")="Answer 'Y' to display the audit trail for each Entry."
DO ^DIR
IF $DATA(DIRUT)
QUIT
IF Y=1
SET DIQ(0)=DIQ(0)_"A"
+10 QUIT
+11 ;7004 N:No;Y:Yes;R:Record Number;B:Both Computed and Number
+12 ;7005 You must have a valid DUZ! ;22*143
+13 ;8002 Include COMPUTED fields
