PRSDFIL ;HISC/REL/FPT-PAID CODE FILE MAINTENANCE ;1/27/93 16:15
;;4.0;PAID;;Sep 21, 1995
ENT ; Edit/Create File Entries
K DIC S DIC="^DD(454,",DIC(0)="AEQM",DIC("S")="I Y>.5",DIC("A")="Select FILE: " W ! D ^DIC K DIC G:Y<1 KIL
S DA=+Y,CODE=$P(^DD(454,DA,0),"^",4),CODE=$P(CODE,";",1)
P1 S (DIC,DIE)="^PRSP(454,1,"""_CODE_""",",DIC(0)="AEQLM",DA(1)=1,DLAYGO=454
W ! D ^DIC I Y<1 K DIE,DA,DLAYGO,CODE G PRSDFIL
S DA=+Y,DA(1)=1,DIDEL=454,DR=".01:99" W ! D ^DIE K DA,D0 G P1
LIST ; List File Entries
K DIC S DIC="^DD(454,",DIC(0)="AEQM",DIC("A")="Select FILE: " W ! D ^DIC K DIC G:Y<1 RSET
S DA=+Y,CODE=$P(^DD(454,DA,0),"^",4),CODE=$P(CODE,";",1),DHD=$P(^DD(454,DA,0),"^",1)
S (DIC,DIE)="^PRSP(454,1,"""_CODE_""",",DIC(0)="AEQLM",DA(1)=1
W ! S L=0,FLDS=".01,1;C8",BY=".01" S (FR,TO)="" S:DA=57 FLDS=".01" D EN1^DIP G LIST
RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DHD,FLDS,FR,L,TO
KIL K DIC,DA,CODE,DIE,DLAYGO,DIDEL,DR,POP,X,Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDFIL 951 printed Dec 13, 2024@02:25:26 Page 2
PRSDFIL ;HISC/REL/FPT-PAID CODE FILE MAINTENANCE ;1/27/93 16:15
+1 ;;4.0;PAID;;Sep 21, 1995
ENT ; Edit/Create File Entries
+1 KILL DIC
SET DIC="^DD(454,"
SET DIC(0)="AEQM"
SET DIC("S")="I Y>.5"
SET DIC("A")="Select FILE: "
WRITE !
DO ^DIC
KILL DIC
if Y<1
GOTO KIL
+2 SET DA=+Y
SET CODE=$PIECE(^DD(454,DA,0),"^",4)
SET CODE=$PIECE(CODE,";",1)
P1 SET (DIC,DIE)="^PRSP(454,1,"""_CODE_""","
SET DIC(0)="AEQLM"
SET DA(1)=1
SET DLAYGO=454
+1 WRITE !
DO ^DIC
IF Y<1
KILL DIE,DA,DLAYGO,CODE
GOTO PRSDFIL
+2 SET DA=+Y
SET DA(1)=1
SET DIDEL=454
SET DR=".01:99"
WRITE !
DO ^DIE
KILL DA,D0
GOTO P1
LIST ; List File Entries
+1 KILL DIC
SET DIC="^DD(454,"
SET DIC(0)="AEQM"
SET DIC("A")="Select FILE: "
WRITE !
DO ^DIC
KILL DIC
if Y<1
GOTO RSET
+2 SET DA=+Y
SET CODE=$PIECE(^DD(454,DA,0),"^",4)
SET CODE=$PIECE(CODE,";",1)
SET DHD=$PIECE(^DD(454,DA,0),"^",1)
+3 SET (DIC,DIE)="^PRSP(454,1,"""_CODE_""","
SET DIC(0)="AEQLM"
SET DA(1)=1
+4 WRITE !
SET L=0
SET FLDS=".01,1;C8"
SET BY=".01"
SET (FR,TO)=""
if DA=57
SET FLDS=".01"
DO EN1^DIP
GOTO LIST
RSET KILL %ZIS
SET IOP=""
DO ^%ZIS
KILL %ZIS,IOP,BY,DHD,FLDS,FR,L,TO
KIL KILL DIC,DA,CODE,DIE,DLAYGO,DIDEL,DR,POP,X,Y
QUIT
