ABMDRCO2.m

ABMDRCO2 ; IHS/ASDST/DMJ - CO VISITS REPORT (PRINT) ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;02/07/96 12:22 PM

 ;

INIT G END:'$D(^TMP("ABMDRCO",ABMD("$J"))) S ABMD("TOT")=0,ABMD("STOP")=""

 S ABMD("FAC")=$P(^DIC(4,DUZ(2),0),"^")

 S ABMD("BDT")=$$SDT^ABMDUTL(ABMD("BDT"))

 S ABMD("EDT")=$$SDT^ABMDUTL(ABMD("EDT"))

 S ABMD("CHMP")=$O(^AUTNINS("B","CHAMPUS",0))

 ;

MAIN I $D(ABMD("TOP")) S ABMD("II")="O" D PRINT,TOTAL^ABMDRCO3 Q:ABMD("STOP")="^"

 I $D(ABMD("TIP")) S ABMD("II")="I" D PRINT,TOTAL^ABMDRCO3 Q:ABMD("STOP")="^"

 I $D(ABMD("TDEN")) S ABMD("II")="D" D PRINT,TOTAL^ABMDRCO3

 Q

 ;

END K:$D(ABMD("$J")) ^TMP("ABMDRCO",ABMD("$J"))

 K ABMD,ABMDSTOP

 Q

 ;

PRINT ;

 D HEAD^ABMDRCO3 S ABMD("BEN")=0

P1 S ABMD("BEN")=$O(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"))) Q:ABMD("BEN")=""  S ABMD("NAME")=0

P2 S ABMD("NAME")=$O(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME"))) G P1:ABMD("NAME")="" S (ABMD("DFN"),ABMD("SUB"))=0

P3 S ABMD("DFN")=$O(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME"),ABMD("DFN"))) I ABMD("DFN")="" W:ABMD("II")'="I" ?114,ABMD("SUB") G P2

 ;

 S ABMD("VDT")=0

P4 S ABMD("VDT")=$O(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"))) G P3:ABMD("VDT")="" S ABMD("VDFN")=0

P5 S ABMD("VDFN")=$O(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN"))) G P4:ABMD("VDFN")="" S ABMD("STR")=^(ABMD("VDFN"))

 S ABMD("HRCN")=$P(ABMD("STR"),"^") S:ABMD("II")="I" ABMD("DSCH")=$P(ABMD("STR"),"^",2)

 S ABMD("BENP")=$P(^AUTTBEN(ABMD("BEN"),0),"^",2) I ABMD("BENP")="03",'$D(ABMD("COFLG")) S ABMD("COFLG")=""

 I ABMD("BENP")'="03",$D(ABMD("COFLG")) D TOTAL^ABMDRCO3 K ABMD("COFLG") D HEAD^ABMDRCO3

 S ABMD("BENP")=$S(ABMD("BENP")="03":"CO",ABMD("BENP")="04":"DEP",ABMD("BENP")="30":"RET",1:"RETD")

 S ABMD("SSN")=$P(^DPT(ABMD("DFN"),0),"^",9)

 S:ABMD("SSN")'="" ABMD("SSN")=$E(ABMD("SSN"),1,3)_"-"_$E(ABMD("SSN"),4,5)_"-"_$E(ABMD("SSN"),6,9)

 ;

WRITE ;print line

 D PAGE^ABMDRCO3:$Y>(IOSL-4) Q:ABMD("STOP")="^"  ;check for end of page

 W:ABMD("SUB")=0 !,$E(ABMD("NAME"),1,20),?23,$J(ABMD("HRCN"),6),?33,ABMD("SSN"),?48,ABMD("BENP")

 I ABMD("II")'="I",(ABMD("SUB")'=0) W !

 D PRVTINS^ABMDRCO3

 W ?97,$$SDT^ABMDUTL(ABMD("VDT"))

 I ABMD("II")'="I" S ABMD("TOT")=ABMD("TOT")+1,ABMD("SUB")=ABMD("SUB")+1 G P5

 W ?110,$$SDT^ABMDUTL(ABMD("DSCH"))

 S X1=ABMD("DSCH"),X2=ABMD("VDT") D ^%DTC S:X=0 X=1 W ?123,X

 S ABMD("TOT")=ABMD("TOT")+X G P5

 D HEAD^ABMDRCO3

ABMDRCO2  ; IHS/ASDST/DMJ - CO VISITS REPORT (PRINT) ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;TMD;02/07/96 12:22 PM

 +3       ;

INIT       IF '$DATA(^TMP("ABMDRCO",ABMD("$J")))

               GOTO END

           SET ABMD("TOT")=0

           SET ABMD("STOP")=""

 +1        SET ABMD("FAC")=$PIECE(^DIC(4,DUZ(2),0),"^")

 +2        SET ABMD("BDT")=$$SDT^ABMDUTL(ABMD("BDT"))

 +3        SET ABMD("EDT")=$$SDT^ABMDUTL(ABMD("EDT"))

 +4        SET ABMD("CHMP")=$ORDER(^AUTNINS("B","CHAMPUS",0))

 +5       ;

MAIN       IF $DATA(ABMD("TOP"))

               SET ABMD("II")="O"

               DO PRINT

               DO TOTAL^ABMDRCO3

               IF ABMD("STOP")="^"

                   QUIT 

 +1        IF $DATA(ABMD("TIP"))

               SET ABMD("II")="I"

               DO PRINT

               DO TOTAL^ABMDRCO3

               IF ABMD("STOP")="^"

                   QUIT 

 +2        IF $DATA(ABMD("TDEN"))

               SET ABMD("II")="D"

               DO PRINT

               DO TOTAL^ABMDRCO3

 +3        QUIT 

 +4       ;

END        IF $DATA(ABMD("$J"))

               KILL ^TMP("ABMDRCO",ABMD("$J"))

 +1        KILL ABMD,ABMDSTOP

 +2        QUIT 

 +3       ;

PRINT     ;

 +1        DO HEAD^ABMDRCO3

           SET ABMD("BEN")=0

P1         SET ABMD("BEN")=$ORDER(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN")))

           IF ABMD("BEN")=""

               QUIT 

           SET ABMD("NAME")=0

P2         SET ABMD("NAME")=$ORDER(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME")))

           IF ABMD("NAME")=""

               GOTO P1

           SET (ABMD("DFN"),ABMD("SUB"))=0

P3         SET ABMD("DFN")=$ORDER(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME"),ABMD("DFN")))

           IF ABMD("DFN")=""

               IF ABMD("II")'="I"

                   WRITE ?114,ABMD("SUB")

               GOTO P2

 +1       ;

 +2        SET ABMD("VDT")=0

P4         SET ABMD("VDT")=$ORDER(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT")))

           IF ABMD("VDT")=""

               GOTO P3

           SET ABMD("VDFN")=0

P5         SET ABMD("VDFN")=$ORDER(^TMP("ABMDRCO",ABMD("$J"),ABMD("II"),ABMD("BEN"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN")))

           IF ABMD("VDFN")=""

               GOTO P4

           SET ABMD("STR")=^(ABMD("VDFN"))

 +1        SET ABMD("HRCN")=$PIECE(ABMD("STR"),"^")

           IF ABMD("II")="I"

               SET ABMD("DSCH")=$PIECE(ABMD("STR"),"^",2)

 +2        SET ABMD("BENP")=$PIECE(^AUTTBEN(ABMD("BEN"),0),"^",2)

           IF ABMD("BENP")="03"

               IF '$DATA(ABMD("COFLG"))

                   SET ABMD("COFLG")=""

 +3        IF ABMD("BENP")'="03"

               IF $DATA(ABMD("COFLG"))

                   DO TOTAL^ABMDRCO3

                   KILL ABMD("COFLG")

                   DO HEAD^ABMDRCO3

 +4        SET ABMD("BENP")=$SELECT(ABMD("BENP")="03":"CO",ABMD("BENP")="04":"DEP",ABMD("BENP")="30":"RET",1:"RETD")

 +5        SET ABMD("SSN")=$PIECE(^DPT(ABMD("DFN"),0),"^",9)

 +6        IF ABMD("SSN")'=""

               SET ABMD("SSN")=$EXTRACT(ABMD("SSN"),1,3)_"-"_$EXTRACT(ABMD("SSN"),4,5)_"-"_$EXTRACT(ABMD("SSN"),6,9)

 +7       ;

WRITE     ;print line

 +1       ;check for end of page

           IF $Y>(IOSL-4)

               DO PAGE^ABMDRCO3

           IF ABMD("STOP")="^"

               QUIT 

 +2        IF ABMD("SUB")=0

               WRITE !,$EXTRACT(ABMD("NAME"),1,20),?23,$JUSTIFY(ABMD("HRCN"),6),?33,ABMD("SSN"),?48,ABMD("BENP")

 +3        IF ABMD("II")'="I"

               IF (ABMD("SUB")'=0)

                   WRITE !

 +4        DO PRVTINS^ABMDRCO3

 +5        WRITE ?97,$$SDT^ABMDUTL(ABMD("VDT"))

 +6        IF ABMD("II")'="I"

               SET ABMD("TOT")=ABMD("TOT")+1

               SET ABMD("SUB")=ABMD("SUB")+1

               GOTO P5

 +7        WRITE ?110,$$SDT^ABMDUTL(ABMD("DSCH"))

 +8        SET X1=ABMD("DSCH")

           SET X2=ABMD("VDT")

           DO ^%DTC

           IF X=0

               SET X=1

           WRITE ?123,X

 +9        SET ABMD("TOT")=ABMD("TOT")+X

           GOTO P5

 +10       DO HEAD^ABMDRCO3