DGSILL.m

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 ---DGSILL   589     printed  Apr 09, 2024@21:50:15                                                                                                                                                                                                       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