DGFI.m

DGFI ;ALB/JDS-MRL - FEMALE INPATIENT OUTPUTS ; 19 JUN 87

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

 S DIC="^DPT(",L=0,BY="'.1,"

 S FR=",",TO="," I $D(^DG(43,1,"GL")) S:$P(^("GL"),U,2) BY=BY_".19,",FR=FR_",",TO=TO_","

 S BY=BY_"@SEX,.01",FR=FR_"E,",TO=TO_"F,",X=3,DGNO=0 D ^DGTEMP G Q:DGNO S FLDS=X

 D EN1^DIP

Q K BY,TO,FR,DIC,DIS,X,DGNO,DHD Q

EN K TD,DGF S %DT="AEPT",%DT("A")="Enter date of Stay: " D ^%DT G Q1:Y'>0 G EN:+Y>(DT+1) S DGT=+Y,DG2=DGT,L=0,DGT=$S(DGT[".":DGT,1:DGT_".2400"),DG2=DGT

EN1 S Y=DGT X ^DD("DD") S DHD="FEMALE INPATIENT FOR "_Y,L=0

 S DIS(1)="S DFN=D0 D ^DGINPW,SET^DGFI I DG1 S ^UTILITY($J,""DG"",D0)=DG1"

 S DIC="^DPT(",BY="@SEX",X=4,DGNO=0 D ^DGTEMP G Q:DGNO S FLDS=X,FR="F,",TO="FZ,"

 I '$D(TD),$D(^DG(43,1,"GL")) S:$P(^("GL"),U,2) BY=BY_",999;""DIVISION: """,FR=FR_"@,",TO=TO_","

 S BY=BY_",.01" D EN1^DIP

 Q:$D(DGF)  K DGT

Q1 K %DT,DFN,DG1,DG2,DGA1,DGX,FLDS,L,POP,^UTILITY($J,"DG") G Q

SET Q:'DG1  S $P(DG1,U,4)=+DG1,$P(DG1,U,1)=+^DGPM(DGA1,0),X=$P(DG1,U,2),$P(DG1,U,10)=$S(X]"":$P(^DG(405.4,+X,0),"^",1),1:"") I $P(DG1,U,3)]"","^1^2^3^13^25^26^43^44^45^"[("^"_$P(DG1,U,3)_"^") S DG1=""

DGFI      ;ALB/JDS-MRL - FEMALE INPATIENT OUTPUTS ; 19 JUN 87

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2       ;

 +3        SET DIC="^DPT("

           SET L=0

           SET BY="'.1,"

 +4        SET FR=","

           SET TO=","

           IF $DATA(^DG(43,1,"GL"))

               IF $PIECE(^("GL"),U,2)

                   SET BY=BY_".19,"

                   SET FR=FR_","

                   SET TO=TO_","

 +5        SET BY=BY_"@SEX,.01"

           SET FR=FR_"E,"

           SET TO=TO_"F,"

           SET X=3

           SET DGNO=0

           DO ^DGTEMP

           IF DGNO

               GOTO Q

           SET FLDS=X

 +6        DO EN1^DIP

Q          KILL BY,TO,FR,DIC,DIS,X,DGNO,DHD

           QUIT 

EN         KILL TD,DGF

           SET %DT="AEPT"

           SET %DT("A")="Enter date of Stay: "

           DO ^%DT

           IF Y'>0

               GOTO Q1

           IF +Y>(DT+1)

               GOTO EN

           SET DGT=+Y

           SET DG2=DGT

           SET L=0

           SET DGT=$SELECT(DGT[".":DGT,1:DGT_".2400")

           SET DG2=DGT

EN1        SET Y=DGT

           XECUTE ^DD("DD")

           SET DHD="FEMALE INPATIENT FOR "_Y

           SET L=0

 +1        SET DIS(1)="S DFN=D0 D ^DGINPW,SET^DGFI I DG1 S ^UTILITY($J,""DG"",D0)=DG1"

 +2        SET DIC="^DPT("

           SET BY="@SEX"

           SET X=4

           SET DGNO=0

           DO ^DGTEMP

           IF DGNO

               GOTO Q

           SET FLDS=X

           SET FR="F,"

           SET TO="FZ,"

 +3        IF '$DATA(TD)

               IF $DATA(^DG(43,1,"GL"))

                   IF $PIECE(^("GL"),U,2)

                       SET BY=BY_",999;""DIVISION: """

                       SET FR=FR_"@,"

                       SET TO=TO_","

 +4        SET BY=BY_",.01"

           DO EN1^DIP

 +5        IF $DATA(DGF)

               QUIT 

           KILL DGT

Q1         KILL %DT,DFN,DG1,DG2,DGA1,DGX,FLDS,L,POP,^UTILITY($JOB,"DG")

           GOTO Q

SET        IF 'DG1

               QUIT 

           SET $PIECE(DG1,U,4)=+DG1

           SET $PIECE(DG1,U,1)=+^DGPM(DGA1,0)

           SET X=$PIECE(DG1,U,2)

           SET $PIECE(DG1,U,10)=$SELECT(X]"":$PIECE(^DG(405.4,+X,0),"^",1),1:"")

           IF $PIECE(DG1,U,3)]""

               IF "^1^2^3^13^25^26^43^44^45^"[("^"_$PIECE(DG1,U,3)_"^")

                   SET DG1=""