- DGSILL ;ALB/JDS - ENTER/EDIT PATIENTS FROM SERIOUSLY ILL LIST ; 19 JUL 84 12:42
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- GET W !! S DIC="^DPT(",DIC(0)="AEQMZ",DIC("S")="I $D(^(.1))" D ^DIC K DIC("S") G Q:Y'>0 S (DA,DFN)=+Y
- W ! S DIE=DIC,DR="401.3;S:X="""" Y=0;401.4//TODAY;" D ^DIE G GET
- ;
- LIST ;SERIOUSLY ILL LIST
- S DIC="^DPT(",L=0,BY="@401.3,"
- I $D(^DG(43,1,"GL")) S:$P(^("GL"),U,2) BY=BY_".19,"
- S BY=BY_".01",FR="",TO="",X=2,DGNO=0 D ^DGTEMP G Q:DGNO S FLDS=X W !!?15,*7,"This output requires 132 columns",!! D EN1^DIP
- Q K A,DA,DFN,DIC,DIE,DIV,DGA1,DGNO,DGT,DGX,%DT,DR,X Q
- DGSILL ;ALB/JDS - ENTER/EDIT PATIENTS FROM SERIOUSLY ILL LIST ; 19 JUL 84 12:42
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;
- GET WRITE !!
- SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- SET DIC("S")="I $D(^(.1))"
- DO ^DIC
- KILL DIC("S")
- IF Y'>0
- GOTO Q
- SET (DA,DFN)=+Y
- +1 WRITE !
- SET DIE=DIC
- SET DR="401.3;S:X="""" Y=0;401.4//TODAY;"
- DO ^DIE
- GOTO GET
- +2 ;
- LIST ;SERIOUSLY ILL LIST
- +1 SET DIC="^DPT("
- SET L=0
- SET BY="@401.3,"
- +2 IF $DATA(^DG(43,1,"GL"))
- IF $PIECE(^("GL"),U,2)
- SET BY=BY_".19,"
- +3 SET BY=BY_".01"
- SET FR=""
- SET TO=""
- SET X=2
- SET DGNO=0
- DO ^DGTEMP
- IF DGNO
- GOTO Q
- SET FLDS=X
- WRITE !!?15,*7,"This output requires 132 columns",!!
- DO EN1^DIP
- Q KILL A,DA,DFN,DIC,DIE,DIV,DGA1,DGNO,DGT,DGX,%DT,DR,X
- QUIT
