- 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 Feb 18, 2025@23:51:57 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
