- DIE ;SFISC/GFT,XAK - PROC.DR-STR ; Dec 06, 2021@13:17:17
- ;;22.2;VA FileMan;**21**;Jan 05, 2016;Build 4
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- N DG,DNM,DICRREC K DB I DIE S DIE=^DIC(DIE,0,"GL")
- Q:$D(@(DIE_DA_",-9)")) Q:'$D(@(DIE_"0)")) S U="^",DP=+$P(^(0),U,2) Q:$P($G(^DD($$FNO^DILIBF(DP),0,"DI")),U,2)["Y"&'$D(DIOVRD)&'$G(DIFROM)
- GO Q:DIE?1"^DIA(".E Q:DA'>0 K DE,DOV,DIOV,DIEC,DTOUT N DIEDA D
- . N %
- . F %=1:1 Q:'$G(DA(%)) S DIEDA(%)=DA(%)
- . S DIEDA=DA
- . Q
- I $D(DIETMP)[0 N DIETMP S DIETMP=$$GETTMP^DIKC1("DIE")
- N DIEFXREF,DIIENS,DIE1,DIE1N K DIEFIRE,DIEBADK,DIESP S DIIENS=$$IENS^DIKCU(DP,.DA)
- S DL=1,DIE1=1,D0=DA,DI=DP,DR(1,DP)=DR D INI I $E(DR)'="[" D DR^DIE17
- S DP=DI,DA=D0,(DQ,DIEL,DK,DP(0))=0 K DIC("S")
- MR S DK=DK+1,DH=$P(DR,";",DK) I +DH=DH S (DI,DM)=DH G S:$D(^DD(DP,DI)),MR
- S DI=$P(DH,":",1) I 'DI G K:DI=0,PB
- J I DH["//" S DE(DQ+1,0)=$P(DH,"//",2,9),DI=$P(DI,"//",1),DH=""
- G K:+DI=DI S DM=+DI,Y=$P(DI,DM,2,99),DI=DM G MR:Y=""!'$D(^DD(DP,DI,0)) S DQ=DQ+1,DZ=^(0),DIFLD(DQ)=DI
- S $P(DZ,U)=$$LABEL^DIALOGZ(DP,DI) ;PROMPT FIELD NAME
- SPC F %=1:1 S DIESP=$P(Y,$C(126),%) Q:DIESP="" D
- .I DIESP="d"!(DIESP="R") S $P(DZ,U,2)=$P(DZ,U,2)_DIESP Q
- .I DIESP="T"!(DIESP="t") S:$G(^DD(DP,DI,.1))]"" $P(DZ,U)=^(.1) Q
- .S $P(DZ,U)=DIESP,DQ(DQ,"CAPTION")=DIESP
- S:DH'[$C(126) DH=DH_$C(126) S DQ(DQ)=DZ K DZ G Y
- ;
- K S DM=$P(DH,":",2),DM=$S(DM:DM,1:DI) I DI,$D(^DD(DP,DI)) G S
- NX S DI=$O(^DD(DP,DI)) S:DI="" DI=-1 G MR:DI'>0,MR:DI>DM
- S I DQ'<50,'$D(DE(DQ+1)) G H
- S DQ=DQ+1,DQ(DQ)=$$LABEL^DIALOGZ(DP,DI)_U_$P(^DD(DP,DI,0),U,2,99),DIFLD(DQ)=DI ;FIELD NAME
- Y S Y=$P(DQ(DQ),"^",4),DG=$P(Y,";",1)
- ;Determine whether field has a xref defined in the Index file
- S DIEXREF=0 F S DIEXREF=$O(^DD("IX","F",DP,DI,DIEXREF)) Q:'DIEXREF I $P($G(^DD("IX",DIEXREF,0)),U) S DIEXREF=1 Q
- I $D(^DD(DP,DI,1))!($P(DQ(DQ),U,2)["a")!DIEXREF S DE=0,DB=DM,DM=0,DE(Y)=DQ K DIEXREF F DW=1:1 S DE=$O(^DD(DP,DI,1,DE)) Q:DE<1 S DE(Y,DW,1)=^(DE,1),DE(Y,DW,2)=^(2)
- I S:DE="" DE=-1
- I $P(DQ(DQ),U,2)["a" S DE(Y,DW,2)="S DIIX=2_U_DIFLD(DE(DQ)) D AUDIT^DIET",DE(Y,DW,1)="S DIIX=3_U_DIFLD(DE(DQ)) D AUDIT^DIET",DE(Y)=DQ I ^DD(DP,DI,"AUDIT")="e" S DE(Y,DW,1)="I $D(DE(DE(DQ)))#2 "_DE(Y,DW,1)
- S Y=$P(Y,";",2) I DU'=DG S D="",DU=DG,@DC G M:Y=0,B:DU=" ",EQ:DW[0 S D=^(DG)
- I Y S:$P(D,"^",Y)]"" DE(DQ)=$P(D,"^",Y)
- E S Y=$E(D,+$E(Y,2,9),$P(Y,",",2)) S:Y'?." " DE(DQ)=Y
- EQ G MR:DI=DM,NX:DM S DM=DB K DB G D
- ;
- INI K DIC("S") S DIC=DIE,DU=-1,DC="DW=$D("_DIE_DA_",DG))"
- Q Q
- ;
- ;
- MORE ;from ^DIE1
- D INI G MR:DI=DM,NX:DI'[U,MR:'$D(^DD(DP,+DI)) S %=$P(DI,U,2),DI=+DI S:%]"" DQ(DQ+1,"CAPTION")=% G S
- ;
- ;
- JMP ;from ^DIE0
- D INI G J
- ;
- PB I DH="" G D:$D(DR(DIE1,DP))<9 S:'$D(DOV) DOV=0,DR(DIE1,DP)=DR S DOV=$O(DR(DIE1,DP,DOV)) S:DOV="" DOV=-1 G D:DOV'>0 S DR=DR(DIE1,DP,DOV),DK=0 G MR
- G MR:DH?1"@".N I 'DQ G TEM:DH?1"[".E S:"Q"'=DH DQ=1,DQ(0,1)=DH G MR:$A(DH)-94 S DC=$P(DH,U,1,4) X $P(DH,U,5,999) D DIE1N G O^DIE0
- E S DK=DK-1,(DI,DM)=1
- D G DQ^DIED
- ;
- H S DI=DI_U G D
- ;Multiple field & WP
- M S Y=$P(DQ(DQ),U,2)_U_DG G DC:DW<9
- I $D(DSC(+Y))#2,$P(DSC(+Y),"I $D(^UTILITY(",1)="" S D=DIEL+1 D D1 X DSC(+Y) S D=$O(^(0)) S:D="" D=-1 S @DC S DC=$O(^(DG,0)) S:DC="" DC=-1 G DE
- I $D(^(DG,0)) S D=$P(^(0),U,3,4) S:$P(^(0),U,2)'=$P(Y,U)&(+Y'=.001) $P(^(0),U,2)=$P(Y,U) ;p21 don't set subDD number if ref. to ^DD(0,.001
- E S D=$O(^(0)) S:D="" D=-1
- DE I D>0 S Y=Y_U_D I DP(0)-Y!($P(DP(0),U,2)-DK),$D(^(+D,0)) S DE(DQ)=$P(^(0),U) ;Default value if this isn't same multiple we were down in before
- DC S DC=$P(^DD(+Y,0),U,4)_U_Y,%=DQ(DQ),Y=^(.01,0)
- MUL I $P(Y,U,2)'["W" S DQ(DQ)=$P($$EZBLD^DIALOG(8042,$G(DQ(DQ,"CAPTION"),$$LABEL^DIALOGZ(+$P(%,U,2),.01))),": ")_U_1_$P(Y,U,2,99) D DIE1N G D ;MULTIPLE-FIELD LABEL
- I DQ>1 K DQ(DQ) G E:$D(DE(DQ,0)),H
- D
- .Q:DH'[$C(126)
- .N DIEA S DIEA=$P($P(DH,+DH,2),$C(126)) Q:DIEA=""!(DIEA="d")!(DIEA="R")
- .I DIEA="T"!(DIEA="t") S:$D(^DD(+$P(%,U,2),.01,.1)) DQ(DQ,"CAPTION")=^(.1) Q
- .S DQ(DQ,"CAPTION")=DIEA
- DIWE S Y=$G(DQ(DQ,"CAPTION"),$$LABEL^DIALOGZ(DP,DI))_U_$P(Y,U,2) D DIEN^DIWE K DQ,DG,DE S DQ=0 G QY^DIE1:$D(DTOUT) G MORE ;WORD-PROCESSING FIELD LABEL
- ;
- D1 Q:D'>0 S:'$D(@("D"_D)) @("D"_D)=0 S D=D-1 G D1
- ;
- DIE1N N M,I S DIE1N="" F I=DK,DK+1 S M=$P(DR,";",I) I M?1"^"1.NP S DIE1N=$P(M,U,2) S:I>DK DK=DK+1 Q ;WPB-0804-30857
- Q
- ;
- ;
- B K DQ(DQ) S DQ=DQ-1,DU=-9 G EQ
- ;
- TEM K:$D(DIETMP)#2 @DIETMP,DIETMP
- S Y=0 F S Y=$O(^DIE("B",$P($E(DR,2,99),"]"),Y)) G Q:Y="",Q:'$D(^DIE(+Y,0)) Q:$P(^(0),U,4)=DP
- S $P(^(0),U,7)=DT I $G(^("ROU"))[U,$$ROUEXIST^DILIBF($P(^("ROU"),U,2)) G @^DIE(+Y,"ROU")
- S:$D(^("W")) DIE("W")=^("W") S DIE("^")=DR K DR S %X="^DIE(+Y,""DR"",",%Y="DR(" D %XY^%RCR
- S DR=$G(^DIE(Y,"DR"),DR(1,DP)) D DIE K DR S DR=DIE(U)
- Q
- ;
- ;Silent call concerning editing and filing of data.
- ;
- FILE(DIEFFLAG,DIEFAR,DIEFOUT) ;
- G FILEX^DIEF
- ;
- WP(DIEFF,DIEFIEN,DIEFFLD,DIEFWPFL,DIEFTSRC,DIEFOUT) ;
- G WPX^DIEFW
- ;
- HELP(DIEHF,DIEHIEN,DIEHFLD,DIEHFLG,DIEHOUT) ;
- G GETX^DIEH
- ;
- VAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEVFAR,DIOUTAR) ;
- G VALX^DIEV
- ;
- KEYVAL(DIVKFLAG,DIVKFDA,DIVKOUT) ;
- G KEYVALX^DIEVK
- ;
- VALS(DIVSFLAG,DIVSEFDA,DIVSIFDA,DIVSMSG) ;
- G VALSX^DIEVS
- ;
- CHK(DIEVF,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIOUTAR) ;
- G CHKX^DIEV
- ;
- UPDATE(DIFLAGS,DIFDA,DIEN,DIMSGA) ;SEA/TOAD
- ; ENTRY POINT--update database
- ; procedure, all passed by value
- G ADDX^DICA
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIE 5621 printed Mar 13, 2025@21:51:43 Page 2
- DIE ;SFISC/GFT,XAK - PROC.DR-STR ; Dec 06, 2021@13:17:17
- +1 ;;22.2;VA FileMan;**21**;Jan 05, 2016;Build 4
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- +7 NEW DG,DNM,DICRREC
- KILL DB
- IF DIE
- SET DIE=^DIC(DIE,0,"GL")
- +8 if $DATA(@(DIE_DA_",-9)"))
- QUIT
- if '$DATA(@(DIE_"0)"))
- QUIT
- SET U="^"
- SET DP=+$PIECE(^(0),U,2)
- if $PIECE($GET(^DD($$FNO^DILIBF(DP),0,"DI")),U,2)["Y"&'$DATA(DIOVRD)&'$GET(DIFROM)
- QUIT
- GO if DIE?1"^DIA(".E
- QUIT
- if DA'>0
- QUIT
- KILL DE,DOV,DIOV,DIEC,DTOUT
- NEW DIEDA
- Begin DoDot:1
- +1 NEW %
- +2 FOR %=1:1
- if '$GET(DA(%))
- QUIT
- SET DIEDA(%)=DA(%)
- +3 SET DIEDA=DA
- +4 QUIT
- End DoDot:1
- +5 IF $DATA(DIETMP)[0
- NEW DIETMP
- SET DIETMP=$$GETTMP^DIKC1("DIE")
- +6 NEW DIEFXREF,DIIENS,DIE1,DIE1N
- KILL DIEFIRE,DIEBADK,DIESP
- SET DIIENS=$$IENS^DIKCU(DP,.DA)
- +7 SET DL=1
- SET DIE1=1
- SET D0=DA
- SET DI=DP
- SET DR(1,DP)=DR
- DO INI
- IF $EXTRACT(DR)'="["
- DO DR^DIE17
- +8 SET DP=DI
- SET DA=D0
- SET (DQ,DIEL,DK,DP(0))=0
- KILL DIC("S")
- MR SET DK=DK+1
- SET DH=$PIECE(DR,";",DK)
- IF +DH=DH
- SET (DI,DM)=DH
- if $DATA(^DD(DP,DI))
- GOTO S
- GOTO MR
- +1 SET DI=$PIECE(DH,":",1)
- IF 'DI
- if DI=0
- GOTO K
- GOTO PB
- J IF DH["//"
- SET DE(DQ+1,0)=$PIECE(DH,"//",2,9)
- SET DI=$PIECE(DI,"//",1)
- SET DH=""
- +1 if +DI=DI
- GOTO K
- SET DM=+DI
- SET Y=$PIECE(DI,DM,2,99)
- SET DI=DM
- if Y=""!'$DATA(^DD(DP,DI,0))
- GOTO MR
- SET DQ=DQ+1
- SET DZ=^(0)
- SET DIFLD(DQ)=DI
- +2 ;PROMPT FIELD NAME
- SET $PIECE(DZ,U)=$$LABEL^DIALOGZ(DP,DI)
- SPC FOR %=1:1
- SET DIESP=$PIECE(Y,$CHAR(126),%)
- if DIESP=""
- QUIT
- Begin DoDot:1
- +1 IF DIESP="d"!(DIESP="R")
- SET $PIECE(DZ,U,2)=$PIECE(DZ,U,2)_DIESP
- QUIT
- +2 IF DIESP="T"!(DIESP="t")
- if $GET(^DD(DP,DI,.1))]""
- SET $PIECE(DZ,U)=^(.1)
- QUIT
- +3 SET $PIECE(DZ,U)=DIESP
- SET DQ(DQ,"CAPTION")=DIESP
- End DoDot:1
- +4 if DH'[$CHAR(126)
- SET DH=DH_$CHAR(126)
- SET DQ(DQ)=DZ
- KILL DZ
- GOTO Y
- +5 ;
- K SET DM=$PIECE(DH,":",2)
- SET DM=$SELECT(DM:DM,1:DI)
- IF DI
- IF $DATA(^DD(DP,DI))
- GOTO S
- NX SET DI=$ORDER(^DD(DP,DI))
- if DI=""
- SET DI=-1
- if DI'>0
- GOTO MR
- if DI>DM
- GOTO MR
- S IF DQ'<50
- IF '$DATA(DE(DQ+1))
- GOTO H
- +1 ;FIELD NAME
- SET DQ=DQ+1
- SET DQ(DQ)=$$LABEL^DIALOGZ(DP,DI)_U_$PIECE(^DD(DP,DI,0),U,2,99)
- SET DIFLD(DQ)=DI
- Y SET Y=$PIECE(DQ(DQ),"^",4)
- SET DG=$PIECE(Y,";",1)
- +1 ;Determine whether field has a xref defined in the Index file
- +2 SET DIEXREF=0
- FOR
- SET DIEXREF=$ORDER(^DD("IX","F",DP,DI,DIEXREF))
- if 'DIEXREF
- QUIT
- IF $PIECE($GET(^DD("IX",DIEXREF,0)),U)
- SET DIEXREF=1
- QUIT
- +3 IF $DATA(^DD(DP,DI,1))!($PIECE(DQ(DQ),U,2)["a")!DIEXREF
- SET DE=0
- SET DB=DM
- SET DM=0
- SET DE(Y)=DQ
- KILL DIEXREF
- FOR DW=1:1
- SET DE=$ORDER(^DD(DP,DI,1,DE))
- if DE<1
- QUIT
- SET DE(Y,DW,1)=^(DE,1)
- SET DE(Y,DW,2)=^(2)
- +4 IF $TEST
- if DE=""
- SET DE=-1
- +5 IF $PIECE(DQ(DQ),U,2)["a"
- SET DE(Y,DW,2)="S DIIX=2_U_DIFLD(DE(DQ)) D AUDIT^DIET"
- SET DE(Y,DW,1)="S DIIX=3_U_DIFLD(DE(DQ)) D AUDIT^DIET"
- SET DE(Y)=DQ
- IF ^DD(DP,DI,"AUDIT")="e"
- SET DE(Y,DW,1)="I $D(DE(DE(DQ)))#2 "_DE(Y,DW,1)
- +6 SET Y=$PIECE(Y,";",2)
- IF DU'=DG
- SET D=""
- SET DU=DG
- SET @DC
- if Y=0
- GOTO M
- if DU=" "
- GOTO B
- if DW[0
- GOTO EQ
- SET D=^(DG)
- +7 IF Y
- if $PIECE(D,"^",Y)]""
- SET DE(DQ)=$PIECE(D,"^",Y)
- +8 IF '$TEST
- SET Y=$EXTRACT(D,+$EXTRACT(Y,2,9),$PIECE(Y,",",2))
- if Y'?." "
- SET DE(DQ)=Y
- EQ if DI=DM
- GOTO MR
- if DM
- GOTO NX
- SET DM=DB
- KILL DB
- GOTO D
- +1 ;
- INI KILL DIC("S")
- SET DIC=DIE
- SET DU=-1
- SET DC="DW=$D("_DIE_DA_",DG))"
- Q QUIT
- +1 ;
- +2 ;
- MORE ;from ^DIE1
- +1 DO INI
- if DI=DM
- GOTO MR
- if DI'[U
- GOTO NX
- if '$DATA(^DD(DP,+DI))
- GOTO MR
- SET %=$PIECE(DI,U,2)
- SET DI=+DI
- if %]""
- SET DQ(DQ+1,"CAPTION")=%
- GOTO S
- +2 ;
- +3 ;
- JMP ;from ^DIE0
- +1 DO INI
- GOTO J
- +2 ;
- PB IF DH=""
- if $DATA(DR(DIE1,DP))<9
- GOTO D
- if '$DATA(DOV)
- SET DOV=0
- SET DR(DIE1,DP)=DR
- SET DOV=$ORDER(DR(DIE1,DP,DOV))
- if DOV=""
- SET DOV=-1
- if DOV'>0
- GOTO D
- SET DR=DR(DIE1,DP,DOV)
- SET DK=0
- GOTO MR
- +1 if DH?1"@".N
- GOTO MR
- IF 'DQ
- if DH?1"[".E
- GOTO TEM
- if "Q"'=DH
- SET DQ=1
- SET DQ(0,1)=DH
- if $ASCII(DH)-94
- GOTO MR
- SET DC=$PIECE(DH,U,1,4)
- XECUTE $PIECE(DH,U,5,999)
- DO DIE1N
- GOTO O^DIE0
- E SET DK=DK-1
- SET (DI,DM)=1
- D GOTO DQ^DIED
- +1 ;
- H SET DI=DI_U
- GOTO D
- +1 ;Multiple field & WP
- M SET Y=$PIECE(DQ(DQ),U,2)_U_DG
- if DW<9
- GOTO DC
- +1 IF $DATA(DSC(+Y))#2
- IF $PIECE(DSC(+Y),"I $D(^UTILITY(",1)=""
- SET D=DIEL+1
- DO D1
- XECUTE DSC(+Y)
- SET D=$ORDER(^(0))
- if D=""
- SET D=-1
- SET @DC
- SET DC=$ORDER(^(DG,0))
- if DC=""
- SET DC=-1
- GOTO DE
- +2 ;p21 don't set subDD number if ref. to ^DD(0,.001
- IF $DATA(^(DG,0))
- SET D=$PIECE(^(0),U,3,4)
- if $PIECE(^(0),U,2)'=$PIECE(Y,U)&(+Y'=.001)
- SET $PIECE(^(0),U,2)=$PIECE(Y,U)
- +3 IF '$TEST
- SET D=$ORDER(^(0))
- if D=""
- SET D=-1
- DE ;Default value if this isn't same multiple we were down in before
- IF D>0
- SET Y=Y_U_D
- IF DP(0)-Y!($PIECE(DP(0),U,2)-DK)
- IF $DATA(^(+D,0))
- SET DE(DQ)=$PIECE(^(0),U)
- DC SET DC=$PIECE(^DD(+Y,0),U,4)_U_Y
- SET %=DQ(DQ)
- SET Y=^(.01,0)
- MUL ;MULTIPLE-FIELD LABEL
- IF $PIECE(Y,U,2)'["W"
- SET DQ(DQ)=$PIECE($$EZBLD^DIALOG(8042,$GET(DQ(DQ,"CAPTION"),$$LABEL^DIALOGZ(+$PIECE(%,U,2),.01))),": ")_U_1_$PIECE(Y,U,2,99)
- DO DIE1N
- GOTO D
- +1 IF DQ>1
- KILL DQ(DQ)
- if $DATA(DE(DQ,0))
- GOTO E
- GOTO H
- +2 Begin DoDot:1
- +3 if DH'[$CHAR(126)
- QUIT
- +4 NEW DIEA
- SET DIEA=$PIECE($PIECE(DH,+DH,2),$CHAR(126))
- if DIEA=""!(DIEA="d")!(DIEA="R")
- QUIT
- +5 IF DIEA="T"!(DIEA="t")
- if $DATA(^DD(+$PIECE(%,U,2),.01,.1))
- SET DQ(DQ,"CAPTION")=^(.1)
- QUIT
- +6 SET DQ(DQ,"CAPTION")=DIEA
- End DoDot:1
- DIWE ;WORD-PROCESSING FIELD LABEL
- SET Y=$GET(DQ(DQ,"CAPTION"),$$LABEL^DIALOGZ(DP,DI))_U_$PIECE(Y,U,2)
- DO DIEN^DIWE
- KILL DQ,DG,DE
- SET DQ=0
- if $DATA(DTOUT)
- GOTO QY^DIE1
- GOTO MORE
- +1 ;
- D1 if D'>0
- QUIT
- if '$DATA(@("D"_D))
- SET @("D"_D)=0
- SET D=D-1
- GOTO D1
- +1 ;
- DIE1N ;WPB-0804-30857
- NEW M,I
- SET DIE1N=""
- FOR I=DK,DK+1
- SET M=$PIECE(DR,";",I)
- IF M?1"^"1.NP
- SET DIE1N=$PIECE(M,U,2)
- if I>DK
- SET DK=DK+1
- QUIT
- +1 QUIT
- +2 ;
- +3 ;
- B KILL DQ(DQ)
- SET DQ=DQ-1
- SET DU=-9
- GOTO EQ
- +1 ;
- TEM if $DATA(DIETMP)#2
- KILL @DIETMP,DIETMP
- +1 SET Y=0
- FOR
- SET Y=$ORDER(^DIE("B",$PIECE($EXTRACT(DR,2,99),"]"),Y))
- if Y=""
- GOTO Q
- if '$DATA(^DIE(+Y,0))
- GOTO Q
- if $PIECE(^(0),U,4)=DP
- QUIT
- +2 SET $PIECE(^(0),U,7)=DT
- IF $GET(^("ROU"))[U
- IF $$ROUEXIST^DILIBF($PIECE(^("ROU"),U,2))
- GOTO @^DIE(+Y,"ROU")
- +3 if $DATA(^("W"))
- SET DIE("W")=^("W")
- SET DIE("^")=DR
- KILL DR
- SET %X="^DIE(+Y,""DR"","
- SET %Y="DR("
- DO %XY^%RCR
- +4 SET DR=$GET(^DIE(Y,"DR"),DR(1,DP))
- DO DIE
- KILL DR
- SET DR=DIE(U)
- +5 QUIT
- +6 ;
- +7 ;Silent call concerning editing and filing of data.
- +8 ;
- FILE(DIEFFLAG,DIEFAR,DIEFOUT) ;
- +1 GOTO FILEX^DIEF
- +2 ;
- WP(DIEFF,DIEFIEN,DIEFFLD,DIEFWPFL,DIEFTSRC,DIEFOUT) ;
- +1 GOTO WPX^DIEFW
- +2 ;
- HELP(DIEHF,DIEHIEN,DIEHFLD,DIEHFLG,DIEHOUT) ;
- +1 GOTO GETX^DIEH
- +2 ;
- VAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEVFAR,DIOUTAR) ;
- +1 GOTO VALX^DIEV
- +2 ;
- KEYVAL(DIVKFLAG,DIVKFDA,DIVKOUT) ;
- +1 GOTO KEYVALX^DIEVK
- +2 ;
- VALS(DIVSFLAG,DIVSEFDA,DIVSIFDA,DIVSMSG) ;
- +1 GOTO VALSX^DIEVS
- +2 ;
- CHK(DIEVF,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIOUTAR) ;
- +1 GOTO CHKX^DIEV
- +2 ;
- UPDATE(DIFLAGS,DIFDA,DIEN,DIMSGA) ;SEA/TOAD
- +1 ; ENTRY POINT--update database
- +2 ; procedure, all passed by value
- +3 GOTO ADDX^DICA
- +4 ;
