DGPTFVC2.m

DGPTFVC2 ;ALB/MJK - Expanded PTF Close-Out Edits ; Jul 20 88

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

 ;called from Q+2^DGPTFTR

 ; input : PTF

 ; output: DGERR   DGERR := 1  if record fails to pass a check

 ;                 DGERR := "" if record passes all checks

EN ;

 Q:'$D(PTF)

 ; -- count mvts

 S DGMAX=25,DGERR="" N C,DGM,I,Y

 F DGM=501,535 S Y=PTF D @DGM I C>DGMAX S DGERR=1 W !,DGM,"  There are '",C,"' ",DGM," movements but only '",DGMAX,"' can be sent to Austin."

 I DGERR W !,"     *** Contact PTF supervisor ***" G ENQ

 ; -- check proc/surg dates

 G ENQ:T1

 S DGDCDT=+$S($D(^DGPT(PTF,70)):^(70),1:"")

 F DGM="P","S" F I=0:0 S I=$O(^DGPT(PTF,DGM,I)) Q:'I  I $D(^(I,0)),+^(0)>DGDCDT S Y=^(0) D ERROR

ENQ K DGMAX,DGDCDT Q

 ;

ERROR ;

 S:'$D(^UTILITY("DG",$J,$S(DGM="P":601,1:401),I)) ^(I)="^" S X=^(I) S:X'["^1^" ^(I)=X_"1^"

 S DGERR=1,Y=+Y X ^DD("DD") W !,">>>> ",$S(DGM="P":"Procedure",1:"Surgery")," date/time of '",Y,"' is after the discharge date."

 ;

LINES ; -- count the number of lines to be xmited for PTF rec

 ; input : Y := ifn of ^DGPT

 ; output: X := line count

 ;

 N NODE,C S X=2

 D 501 S X=X+C D 535 S X=X+C F NODE="P","S" F %=0:0 S %=$O(^DGPT(Y,NODE,%)) Q:'%  I $D(^(%,0)),+^(0)'<T1,+^(0)'>T2 S X=X+1

 Q

 ;

501 ; -- count 501 mvts to xmit

 ; input : Y    := IFN

 ;         DGMTY := indicates entering from flag option [optional]

 ; output: C    := # of entries

 ;

 N Z,D S C=1 ; always one 501

 ; count & check if between date range & ok to xmit

 F %=1:0 S %=$O(^DGPT(Y,"M",%)) Q:'%  S C=C+1 I '$D(DGMTY),$D(^(%,0)) S Z=^(0),D=$P(Z,U,10) I D<T1!(D>T2)!($P(Z,U,17)="n") S C=C-1

 Q

 ;

535 ; -- count 535 mvts to xmit

 ; input : Y    := IFN

 ;         DGMTY := indicates entering from flag option [optional]

 ; output: C    := # of entries

 ;

 N Z,D S C=0

 ; count & check if between date range & ok to xmit & not a 501 on date

 F %=0:0 S %=$O(^DGPT(Y,535,%)) Q:'%  S C=C+1 I '$D(DGMTY),$D(^(%,0)) S Z=^(0),D=$P(Z,U,10) I 'D!(D<T1)!(D>T2)!($P(Z,U,17)="n")!($D(^DGPT(Y,"M","AM",+D))) S C=C-1

 Q

 ;

DGPTFVC2  ;ALB/MJK - Expanded PTF Close-Out Edits ; Jul 20 88

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

 +2       ;called from Q+2^DGPTFTR

 +3       ; input : PTF

 +4       ; output: DGERR   DGERR := 1  if record fails to pass a check

 +5       ;                 DGERR := "" if record passes all checks

EN        ;

 +1        IF '$DATA(PTF)

               QUIT 

 +2       ; -- count mvts

 +3        SET DGMAX=25

           SET DGERR=""

           NEW C,DGM,I,Y

 +4        FOR DGM=501,535

               SET Y=PTF

               DO @DGM

               IF C>DGMAX

                   SET DGERR=1

                   WRITE !,DGM,"  There are '",C,"' ",DGM," movements but only '",DGMAX,"' can be sent to Austin."

 +5        IF DGERR

               WRITE !,"     *** Contact PTF supervisor ***"

               GOTO ENQ

 +6       ; -- check proc/surg dates

 +7        IF T1

               GOTO ENQ

 +8        SET DGDCDT=+$SELECT($DATA(^DGPT(PTF,70)):^(70),1:"")

 +9        FOR DGM="P","S"

               FOR I=0:0

                   SET I=$ORDER(^DGPT(PTF,DGM,I))

                   IF 'I

                       QUIT 

                   IF $DATA(^(I,0))

                       IF +^(0)>DGDCDT

                           SET Y=^(0)

                           DO ERROR

ENQ        KILL DGMAX,DGDCDT

           QUIT 

 +1       ;

ERROR     ;

 +1        IF '$DATA(^UTILITY("DG",$JOB,$SELECT(DGM="P"

               SET ^(I)="^"

           SET X=^(I)

           IF X'["^1^"

               SET ^(I)=X_"1^"

 +2        SET DGERR=1

           SET Y=+Y

           XECUTE ^DD("DD")

           WRITE !,">>>> ",$SELECT(DGM="P":"Procedure",1:"Surgery")," date/time of '",Y,"' is after the discharge date."

 +3       ;

LINES     ; -- count the number of lines to be xmited for PTF rec

 +1       ; input : Y := ifn of ^DGPT

 +2       ; output: X := line count

 +3       ;

 +4        NEW NODE,C

           SET X=2

 +5        DO 501

           SET X=X+C

           DO 535

           SET X=X+C

           FOR NODE="P","S"

               FOR %=0:0

                   SET %=$ORDER(^DGPT(Y,NODE,%))

                   IF '%

                       QUIT 

                   IF $DATA(^(%,0))

                       IF +^(0)'<T1

                           IF +^(0)'>T2

                               SET X=X+1

 +6        QUIT 

 +7       ;

501       ; -- count 501 mvts to xmit

 +1       ; input : Y    := IFN

 +2       ;         DGMTY := indicates entering from flag option [optional]

 +3       ; output: C    := # of entries

 +4       ;

 +5       ; always one 501

           NEW Z,D

           SET C=1

 +6       ; count & check if between date range & ok to xmit

 +7        FOR %=1:0

               SET %=$ORDER(^DGPT(Y,"M",%))

               IF '%

                   QUIT 

               SET C=C+1

               IF '$DATA(DGMTY)

                   IF $DATA(^(%,0))

                       SET Z=^(0)

                       SET D=$PIECE(Z,U,10)

                       IF D<T1!(D>T2)!($PIECE(Z,U,17)="n")

                           SET C=C-1

 +8        QUIT 

 +9       ;

535       ; -- count 535 mvts to xmit

 +1       ; input : Y    := IFN

 +2       ;         DGMTY := indicates entering from flag option [optional]

 +3       ; output: C    := # of entries

 +4       ;

 +5        NEW Z,D

           SET C=0

 +6       ; count & check if between date range & ok to xmit & not a 501 on date

 +7        FOR %=0:0

               SET %=$ORDER(^DGPT(Y,535,%))

               IF '%

                   QUIT 

               SET C=C+1

               IF '$DATA(DGMTY)

                   IF $DATA(^(%,0))

                       SET Z=^(0)

                       SET D=$PIECE(Z,U,10)

                       IF 'D!(D<T1)!(D>T2)!($PIECE(Z,U,17)="n")!($DATA(^DGPT(Y,"M","AM",+D)))

                           SET C=C-1

 +8        QUIT 

 +9       ;