source: WorldVistAEHR/trunk/r/PAID-PRS/PRSDFIL.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 936 bytes
RevLine 
[613]1PRSDFIL ;HISC/REL/FPT-PAID CODE FILE MAINTENANCE ;1/27/93 16:15
2 ;;4.0;PAID;;Sep 21, 1995
3ENT ; Edit/Create File Entries
4 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
5 S DA=+Y,CODE=$P(^DD(454,DA,0),"^",4),CODE=$P(CODE,";",1)
6P1 S (DIC,DIE)="^PRSP(454,1,"""_CODE_""",",DIC(0)="AEQLM",DA(1)=1,DLAYGO=454
7 W ! D ^DIC I Y<1 K DIE,DA,DLAYGO,CODE G PRSDFIL
8 S DA=+Y,DA(1)=1,DIDEL=454,DR=".01:99" W ! D ^DIE K DA,D0 G P1
9LIST ; List File Entries
10 K DIC S DIC="^DD(454,",DIC(0)="AEQM",DIC("A")="Select FILE: " W ! D ^DIC K DIC G:Y<1 RSET
11 S DA=+Y,CODE=$P(^DD(454,DA,0),"^",4),CODE=$P(CODE,";",1),DHD=$P(^DD(454,DA,0),"^",1)
12 S (DIC,DIE)="^PRSP(454,1,"""_CODE_""",",DIC(0)="AEQLM",DA(1)=1
13 W ! S L=0,FLDS=".01,1;C8",BY=".01" S (FR,TO)="" S:DA=57 FLDS=".01" D EN1^DIP G LIST
14RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DHD,FLDS,FR,L,TO
15KIL K DIC,DA,CODE,DIE,DLAYGO,DIDEL,DR,POP,X,Y Q
Note: See TracBrowser for help on using the repository browser.