PRSDFIL.m

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 ---PRSDFIL   951     printed  Apr 09, 2024@21:26:45                                                                                                                                                                                                      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