SCDXPOV1 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ;11/29/99 19:23
;;5.3;Scheduling;**73,173**;AUG 13, 1993
Q
WRT ; Entry point for printing visit reprot
;
; Variables:
; DVN - Division IEN used in VA(389.9, and DG(40.8 for retreiving division name
; DNAME - Division name for printing on report
; SDASH - Single dash line for report formatting
; SDBDASH - Double dash line for report formatting
; SCETOT - Total encounters, Eligibility
;
N DVN,DNAME,SDASH,SDBDASH,SDNM,SCETOT
S $P(SDASH,"-",40)="",$P(SDBDASH,"=",76)=""
;
U IO
I 'SCXMD D G END
. S DVN=$P($$SITE^VASITE(SCXBEG),U,3),DNAME=$P($$SITE^VASITE(SCXBEG),U,2)
. D XMTPRT
;
I SCXTFLG D G END
. S DVN="TOT",DNAME="FACILITY TOTALS: "_$P($$SITE^VASITE(SCXBEG),U,2)
. D XMTPRT
;
S DVN=0
F S DVN=$O(^TMP("SCDXPOV",$J,DVN)) Q:DVN="" S:DVN'["TOT" SDNM=$O(^VA(389.9,"D",DVN,0)),DNAME=+$P(^VA(389.9,SDNM,0),U,3) D Q:SCXABRT
. S DNAME=$S('DNAME:"UNKNOWN "_DVN,'$D(^DG(40.8,DNAME,0)):"UNKNOWN",1:$P(^DG(40.8,DNAME,0),U))
. S:DVN["TOT" DNAME="FACILITY TOTALS: "_$P($$SITE^VASITE(SCXBEG),U,2)
. D XMTPRT
END Q
;
XMTPRT ; Print data for visit report
;
; Variables
; NUM, LL1 - Local counters
; SBTT - Track subtotals for each category
; LL - Temporary holder for encounter status values
;
N LL,SBTT,LL1,NUM,SCETOT
;
D HDR1
;
W !,?5,"VETERAN ELIGIBILITY",!
K SBTT,LL
S NUM=0
F S NUM=$O(^TMP("SCDXPOV",$J,DVN,"VELIG",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
. S LL=^TMP("SCDXPOV",$J,DVN,"VELIG",NUM)
. W !?8,$P(^DIC(8,NUM,0),U),?40,$J(+$P(LL,U,1),6),?51,$J(+$P(LL,U,2),6),?65,$J(+$P(LL,U,3),6)
. F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
;
W !?38,SDASH,!,?5,"Veteran Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
F LL1=1:1:3 S SCETOT(LL1)=+$G(SCETOT(LL1))+$G(SBTT(LL1))
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
;
W !!,?5,"NON-VETERAN ELIGIBILITY",!
K SBTT,LL
S NUM=0
F S NUM=$O(^TMP("SCDXPOV",$J,DVN,"NVELIG",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
. S LL=^TMP("SCDXPOV",$J,DVN,"NVELIG",NUM)
. W !?8,$P(^DIC(8,NUM,0),U),?40,$J(+$P(LL,U,1),6),?51,$J(+$P(LL,U,2),6),?65,$J(+$P(LL,U,3),6)
. F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
;
W !?38,SDASH,!,?5,"Non-Veteran Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
F LL1=1:1:3 S SCETOT(LL1)=+$G(SCETOT(LL1))+$G(SBTT(LL1))
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
;
W !!,?5,"CATEGORY OF VISIT",!
K SBTT,LL
S NUM=0
F S NUM=$O(^TMP("SCDXPOV",$J,DVN,"COV",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
. S LL=^TMP("SCDXPOV",$J,DVN,"COV",NUM)
. W !?8,$P($T(VISIT+NUM),";",3),?40,$J($P(LL,U,1),6),?51,$J($P(LL,U,2),6),?65,$J($P(LL,U,3),6)
. F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
;
W !?38,SDASH,!,?5,"Category Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
;
W !!?2,SDBDASH,!?5,$S(DNAME["FACILITY":"Facility Total",1:"Total for "_$E(DNAME,1,25))_":",?40,$J(SCETOT(1),6),?51,$J(SCETOT(2),6),?65,$J(SCETOT(3),6)
W !?16,"Total: ",SCETOT(1)+SCETOT(2)+SCETOT(3)
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
;
W !!,?8,"Compensation and Pension appointments are included in the above",!?8,"categories and totals and are shown here for information only"
K LL S LL=^TMP("SCDXPOV",$J,DVN,"CP")
W !!?8,"COMPENSATION AND PENSION",?40,$J($P(LL,U,1),6),?51,$J($P(LL,U,2),6),?65,$J($P(LL,U,3),6)
;
I SCXOPT>1&(IOST?1"C-".E) K LL W !," Press RETURN to continue or '^' to exit: " R LL:DTIME S SCXABRT='$T!(LL="^")
;
XMTQ Q
;
HDR1 ; Print report header and column headers
N HD2,HD1
W @IOF
S HD1="ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
W !?(IOM-$L(HD1))/2,"ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
S HD2="FOR PERIOD "
S Y=SCXBEG D DTS^SDUTL
S HD2=HD2_Y_" THRU "
S Y=SCXEND D DTS^SDUTL
S HD2=HD2_Y
W !?2,DNAME,$S(DVN'["TOT"&SCXMD:" DIVISION",1:""),?(IOM-$L(HD2))-5,HD2
W !!,?54,"ENCOUNTERS",!?38,SDASH
W !?40,"WAITING",?51,"TRANSMITTED",?65,"ACKNOWLEDGED"
W !?2,SDBDASH
Q
;
NEWPAGE ;
I IOST?1"C-".E S DIR(0)="E" D ^DIR S SCXABRT='+$G(Y) D CLEAR^SCDXPOV2
I 'SCXABRT D HDR1
Q
;
VISIT ; Category of visits Displayed value/Stored value
;;SCHEDULED VISIT;APPOINTMENT
;;UNSCHEDULED VISIT;STOP CODE ADDITION
;;10 - 10;DISPOSITION
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXPOV1 4472 printed Nov 22, 2024@17:49:20 Page 2
SCDXPOV1 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ;11/29/99 19:23
+1 ;;5.3;Scheduling;**73,173**;AUG 13, 1993
+2 QUIT
WRT ; Entry point for printing visit reprot
+1 ;
+2 ; Variables:
+3 ; DVN - Division IEN used in VA(389.9, and DG(40.8 for retreiving division name
+4 ; DNAME - Division name for printing on report
+5 ; SDASH - Single dash line for report formatting
+6 ; SDBDASH - Double dash line for report formatting
+7 ; SCETOT - Total encounters, Eligibility
+8 ;
+9 NEW DVN,DNAME,SDASH,SDBDASH,SDNM,SCETOT
+10 SET $PIECE(SDASH,"-",40)=""
SET $PIECE(SDBDASH,"=",76)=""
+11 ;
+12 USE IO
+13 IF 'SCXMD
Begin DoDot:1
+14 SET DVN=$PIECE($$SITE^VASITE(SCXBEG),U,3)
SET DNAME=$PIECE($$SITE^VASITE(SCXBEG),U,2)
+15 DO XMTPRT
End DoDot:1
GOTO END
+16 ;
+17 IF SCXTFLG
Begin DoDot:1
+18 SET DVN="TOT"
SET DNAME="FACILITY TOTALS: "_$PIECE($$SITE^VASITE(SCXBEG),U,2)
+19 DO XMTPRT
End DoDot:1
GOTO END
+20 ;
+21 SET DVN=0
+22 FOR
SET DVN=$ORDER(^TMP("SCDXPOV",$JOB,DVN))
if DVN=""
QUIT
if DVN'["TOT"
SET SDNM=$ORDER(^VA(389.9,"D",DVN,0))
SET DNAME=+$PIECE(^VA(389.9,SDNM,0),U,3)
Begin DoDot:1
+23 SET DNAME=$SELECT('DNAME:"UNKNOWN "_DVN,'$DATA(^DG(40.8,DNAME,0)):"UNKNOWN",1:$PIECE(^DG(40.8,DNAME,0),U))
+24 if DVN["TOT"
SET DNAME="FACILITY TOTALS: "_$PIECE($$SITE^VASITE(SCXBEG),U,2)
+25 DO XMTPRT
End DoDot:1
if SCXABRT
QUIT
END QUIT
+1 ;
XMTPRT ; Print data for visit report
+1 ;
+2 ; Variables
+3 ; NUM, LL1 - Local counters
+4 ; SBTT - Track subtotals for each category
+5 ; LL - Temporary holder for encounter status values
+6 ;
+7 NEW LL,SBTT,LL1,NUM,SCETOT
+8 ;
+9 DO HDR1
+10 ;
+11 WRITE !,?5,"VETERAN ELIGIBILITY",!
+12 KILL SBTT,LL
+13 SET NUM=0
+14 FOR
SET NUM=$ORDER(^TMP("SCDXPOV",$JOB,DVN,"VELIG",NUM))
if 'NUM
QUIT
Begin DoDot:1
+15 SET LL=^TMP("SCDXPOV",$JOB,DVN,"VELIG",NUM)
+16 WRITE !?8,$PIECE(^DIC(8,NUM,0),U),?40,$JUSTIFY(+$PIECE(LL,U,1),6),?51,$JUSTIFY(+$PIECE(LL,U,2),6),?65,$JUSTIFY(+$PIECE(LL,U,3),6)
+17 FOR LL1=1:1:3
SET SBTT(LL1)=+$GET(SBTT(LL1))+$PIECE(LL,U,LL1)
End DoDot:1
IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO XMTQ
+18 ;
+19 WRITE !?38,SDASH,!,?5,"Veteran Sub-Total",?40,$JUSTIFY(SBTT(1),6),?51,$JUSTIFY(SBTT(2),6),?65,$JUSTIFY(SBTT(3),6)
+20 FOR LL1=1:1:3
SET SCETOT(LL1)=+$GET(SCETOT(LL1))+$GET(SBTT(LL1))
+21 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO XMTQ
+22 ;
+23 WRITE !!,?5,"NON-VETERAN ELIGIBILITY",!
+24 KILL SBTT,LL
+25 SET NUM=0
+26 FOR
SET NUM=$ORDER(^TMP("SCDXPOV",$JOB,DVN,"NVELIG",NUM))
if 'NUM
QUIT
Begin DoDot:1
+27 SET LL=^TMP("SCDXPOV",$JOB,DVN,"NVELIG",NUM)
+28 WRITE !?8,$PIECE(^DIC(8,NUM,0),U),?40,$JUSTIFY(+$PIECE(LL,U,1),6),?51,$JUSTIFY(+$PIECE(LL,U,2),6),?65,$JUSTIFY(+$PIECE(LL,U,3),6)
+29 FOR LL1=1:1:3
SET SBTT(LL1)=+$GET(SBTT(LL1))+$PIECE(LL,U,LL1)
End DoDot:1
IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO XMTQ
+30 ;
+31 WRITE !?38,SDASH,!,?5,"Non-Veteran Sub-Total",?40,$JUSTIFY(SBTT(1),6),?51,$JUSTIFY(SBTT(2),6),?65,$JUSTIFY(SBTT(3),6)
+32 FOR LL1=1:1:3
SET SCETOT(LL1)=+$GET(SCETOT(LL1))+$GET(SBTT(LL1))
+33 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO XMTQ
+34 ;
+35 WRITE !!,?5,"CATEGORY OF VISIT",!
+36 KILL SBTT,LL
+37 SET NUM=0
+38 FOR
SET NUM=$ORDER(^TMP("SCDXPOV",$JOB,DVN,"COV",NUM))
if 'NUM
QUIT
Begin DoDot:1
+39 SET LL=^TMP("SCDXPOV",$JOB,DVN,"COV",NUM)
+40 WRITE !?8,$PIECE($TEXT(VISIT+NUM),";",3),?40,$JUSTIFY($PIECE(LL,U,1),6),?51,$JUSTIFY($PIECE(LL,U,2),6),?65,$JUSTIFY($PIECE(LL,U,3),6)
+41 FOR LL1=1:1:3
SET SBTT(LL1)=+$GET(SBTT(LL1))+$PIECE(LL,U,LL1)
End DoDot:1
IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO XMTQ
+42 ;
+43 WRITE !?38,SDASH,!,?5,"Category Sub-Total",?40,$JUSTIFY(SBTT(1),6),?51,$JUSTIFY(SBTT(2),6),?65,$JUSTIFY(SBTT(3),6)
+44 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO XMTQ
+45 ;
+46 WRITE !!?2,SDBDASH,!?5,$SELECT(DNAME["FACILITY":"Facility Total",1:"Total for "_$EXTRACT(DNAME,1,25))_":",?40,$JUSTIFY(SCETOT(1),6),?51,$JUSTIFY(SCETOT(2),6),?65,$JUSTIFY(SCETOT(3),6)
+47 WRITE !?16,"Total: ",SCETOT(1)+SCETOT(2)+SCETOT(3)
+48 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO XMTQ
+49 ;
+50 WRITE !!,?8,"Compensation and Pension appointments are included in the above",!?8,"categories and totals and are shown here for information only"
+51 KILL LL
SET LL=^TMP("SCDXPOV",$JOB,DVN,"CP")
+52 WRITE !!?8,"COMPENSATION AND PENSION",?40,$JUSTIFY($PIECE(LL,U,1),6),?51,$JUSTIFY($PIECE(LL,U,2),6),?65,$JUSTIFY($PIECE(LL,U,3),6)
+53 ;
+54 IF SCXOPT>1&(IOST?1"C-".E)
KILL LL
WRITE !," Press RETURN to continue or '^' to exit: "
READ LL:DTIME
SET SCXABRT='$TEST!(LL="^")
+55 ;
XMTQ QUIT
+1 ;
HDR1 ; Print report header and column headers
+1 NEW HD2,HD1
+2 WRITE @IOF
+3 SET HD1="ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
+4 WRITE !?(IOM-$LENGTH(HD1))/2,"ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
+5 SET HD2="FOR PERIOD "
+6 SET Y=SCXBEG
DO DTS^SDUTL
+7 SET HD2=HD2_Y_" THRU "
+8 SET Y=SCXEND
DO DTS^SDUTL
+9 SET HD2=HD2_Y
+10 WRITE !?2,DNAME,$SELECT(DVN'["TOT"&SCXMD:" DIVISION",1:""),?(IOM-$LENGTH(HD2))-5,HD2
+11 WRITE !!,?54,"ENCOUNTERS",!?38,SDASH
+12 WRITE !?40,"WAITING",?51,"TRANSMITTED",?65,"ACKNOWLEDGED"
+13 WRITE !?2,SDBDASH
+14 QUIT
+15 ;
NEWPAGE ;
+1 IF IOST?1"C-".E
SET DIR(0)="E"
DO ^DIR
SET SCXABRT='+$GET(Y)
DO CLEAR^SCDXPOV2
+2 IF 'SCXABRT
DO HDR1
+3 QUIT
+4 ;
VISIT ; Category of visits Displayed value/Stored value
+1 ;;SCHEDULED VISIT;APPOINTMENT
+2 ;;UNSCHEDULED VISIT;STOP CODE ADDITION
+3 ;;10 - 10;DISPOSITION
