DGSILL ;ALB/JDS - ENTER/EDIT PATIENTS FROM SERIOUSLY ILL LIST ; 19 JUL 84 12:42
;;5.3;Registration;;Aug 13, 1993
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGSILL 589 printed Nov 22, 2024@18:08:56 Page 2
DGSILL ;ALB/JDS - ENTER/EDIT PATIENTS FROM SERIOUSLY ILL LIST ; 19 JUL 84 12:42
+1 ;;5.3;Registration;;Aug 13, 1993
+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
