SCDXPOV3 ; ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 05 Oct 98 8:38 PM
;;5.3;Scheduling;**73,159,173**;AUG 13, 1993
Q
VISIT(SCXDT,SCXP,SCXE,SCXET,SCXV,SCXC) ; Update visit count for this encounter
; Input:
; SCXDT - Visit date
; SCXP - Patients DFN
; SCXE - Vet Eligibility status of encounter
; SCXET - Vet. or Non-Vet status
; SCXV - Category of visit
; SCXC - C&P status of encounter
;
; Variables:
; SCHL - Current Hierarchy level
; L1 - Local variable
;
N L1,SCHL
;
I $D(^TMP("SCDXV",$J,"ELG",SCXDT,SCXP)) D
. S SCHL=$P(^TMP("SCDXV",$J,"ELG",SCXDT,SCXP),U,3)
. S L1=$$ELGPRI^SCDXPOV2(SCXE,SCHL)
. S:$P(L1,U,2) ^TMP("SCDXV",$J,"ELG",SCXDT,SCXP)=SCXE_U_SCXET_U_$P(L1,U)
E S ^TMP("SCDXV",$J,"ELG",SCXDT,SCXP)=SCXE_U_SCXET_U_$P($$ELGPRI^SCDXPOV2(SCXE,0),U)
;
I $D(^TMP("SCDXV",$J,"COV",SCXDT,SCXP)) D
. S SCHL=$P(^TMP("SCDXV",$J,"COV",SCXDT,SCXP),U,2)
. S L1=$$COVPRI^SCDXPOV2(SCXV,SCHL)
. S:$P(L1,U,2) ^TMP("SCDXV",$J,"COV",SCXDT,SCXP)=SCXV_U_$P(L1,U)
E S ^TMP("SCDXV",$J,"COV",SCXDT,SCXP)=SCXV_U_$P($$COVPRI^SCDXPOV2(SCXV,0),U)
;
I SCXC,'$D(^TMP("SCDXV",$J,"CP",SCXDT,SCXP)) D
. S ^TMP("SCDXV",$J,"CP",SCXDT,SCXP)=1
Q
;
WRT ; Call procedures to initialize report data global, build the report global, and then print the report.
;
; Variables
; DVN - Facility number from VASITE
; DNAME - Facility name from VASITE
;
N SDBDASH,SDASH,DNAME,DVN
S $P(SDBDASH,"=",75)="",$P(SDASH,"-",15)=""
U IO
;
S DVN=$P($$SITE^VASITE(SCXBEG),U,3),DNAME=$P($$SITE^VASITE(SCXBEG),U,2)
D INIT^SCDXPOV("VISITS"),BLDRPT,VISRPT
Q
;
BLDRPT ; Build data global for report. Order through date/patient TMP global, and count the number of unique
; visits. Increment the appropriate report data global.
;
; Variables
; SCXDT - Date the Visit occurred (Encounter date)
; SCXP - DFN of patient for this encounter
; SCX - Node of TMP global visits are being counted from
; LV1 - Local variable for incremneting report data global
;
N SCXDT,SCXP,SCX,LV1
S SCXDT=""
; Count visits for Vet./Non-Vet. eligibility
F S SCXDT=$O(^TMP("SCDXV",$J,"ELG",SCXDT)) Q:SCXDT'>0 D
. S SCXP="" F S SCXP=$O(^TMP("SCDXV",$J,"ELG",SCXDT,SCXP)) Q:'SCXP D
.. S SCX=^TMP("SCDXV",$J,"ELG",SCXDT,SCXP)
.. S LV1=$P($G(^TMP("SCDXPOV",$J,"VISITS",$S($P(SCX,U,2)="Y":"VELIG",1:"NVELIG"),$P(SCX,U))),U)
.. S $P(^TMP("SCDXPOV",$J,"VISITS",$S($P(SCX,U,2)="Y":"VELIG",1:"NVELIG"),$P(SCX,U)),U)=LV1+1
;
; Count visits for Category of Visit.
F S SCXDT=$O(^TMP("SCDXV",$J,"COV",SCXDT)) Q:SCXDT'>0 D
. S SCXP="" F S SCXP=$O(^TMP("SCDXV",$J,"COV",SCXDT,SCXP)) Q:'SCXP D
.. S LV1=$P(^TMP("SCDXPOV",$J,"VISITS","COV",$P(^TMP("SCDXV",$J,"COV",SCXDT,SCXP),U)),U)
.. S $P(^TMP("SCDXPOV",$J,"VISITS","COV",$P(^TMP("SCDXV",$J,"COV",SCXDT,SCXP),U)),U)=LV1+1
;
; Count visits with a type of appt. of C&P
F S SCXDT=$O(^TMP("SCDXV",$J,"CP",SCXDT)) Q:SCXDT'>0 D
. S SCXP="" F S SCXP=$O(^TMP("SCDXV",$J,"CP",SCXDT,SCXP)) Q:'SCXP D
.. S $P(^TMP("SCDXPOV",$J,"VISITS","CP"),U)=$P(^TMP("SCDXPOV",$J,"VISITS","CP"),U)+1
Q
;
VISRPT ; Print body of the Visit report consolidated by number of visits.
;
; Variables
; SBTT - Subtotal of categories
; NUM - local counting variable
; SCDXABRT - Abort Printing (Screen only)
;
N NUM,SBTT,L1
;
D HDR
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT VISQ
W !,?5,"VETERAN ELIGIBILITY",!
S (NUM,SBTT)=0
F S NUM=$O(^TMP("SCDXPOV",$J,"VISITS","VELIG",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT VISQ
. W !?8,$P(^DIC(8,NUM,0),U),?45,$J($P(^TMP("SCDXPOV",$J,"VISITS","VELIG",NUM),U),6)
. S SBTT=+$G(SBTT)+$P(^TMP("SCDXPOV",$J,"VISITS","VELIG",NUM),U)
;
W !?42,SDASH,!,?5,"Veteran Sub-Total",?45,$J(SBTT,6)
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT VISQ
;
W !!,?5,"NON-VETERAN ELIGIBILITY",!
S (NUM,SBTT)=0
F S NUM=$O(^TMP("SCDXPOV",$J,"VISITS","NVELIG",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT VISQ
. W !?8,$P(^DIC(8,NUM,0),U),?45,$J($P(^TMP("SCDXPOV",$J,"VISITS","NVELIG",NUM),U),6)
. S SBTT=+$G(SBTT)+$P(^TMP("SCDXPOV",$J,"VISITS","NVELIG",NUM),U)
;
W !?42,SDASH,!,?5,"Non-Veteran Sub-Total",?45,$J(SBTT,6)
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT VISQ
;
W !!,?5,"CATEGORY OF VISIT",!
S (NUM,SBTT)=0
F S NUM=$O(^TMP("SCDXPOV",$J,"VISITS","COV",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT VISQ
. W !?8,$P($T(VISIT+NUM^SCDXPOV1),";",3),?45,$J($P(^TMP("SCDXPOV",$J,"VISITS","COV",NUM),U),6)
. S SBTT=+$G(SBTT)+$P(^TMP("SCDXPOV",$J,"VISITS","COV",NUM),U)
;
W !?42,SDASH,!,?5,"Category Sub-Total",?45,$J(SBTT,6)
I $Y>(IOSL-8) D NEWPAGE G:SCXABRT VISQ
;
W !!,?8,"Compensation and Penison appointments are included in the above",!?8,"categories and totals and are shown here for information only"
W !!?8,"COMPENSATION AND PENSION",?45,$J($P(^TMP("SCDXPOV",$J,"VISITS","CP"),U),6)
;
VISQ Q
;
HDR ; Print the report header
; Variables
; LINEOUT - Message line for header
; END - Timeout or Uparrow flag for read
;
N END,LINEOUT,LL,HD1,HD2
;
W @IOF
S HD2="VISIT REPORT FOR ACTIVITY TRANSMITTED TO NPCDB"
W !?(IOM-$L(HD2))/2,HD2
S HD1="FOR PERIOD "
S Y=SCXBEG D DTS^SDUTL
S HD1=HD1_Y_" THRU "
S Y=SCXEND D DTS^SDUTL
S HD1=HD1_Y
W !?2,"Facility: "_DNAME,?(IOM-$L(HD1))-5,HD1
W !!
F LL=0:1 S LINEOUT=$P($T(MSG+(LL+1)),";;",2) Q:LINEOUT["$$END" W !?8,LINEOUT
W !!?48,"VISITS"
W !,SDBDASH
Q
;
NEWPAGE ;
N LL
I IOST?1"C-".E S DIR(0)="E" D ^DIR S SCXABRT='+$G(Y) D CLEAR^SCDXPOV2
;W !," Press RETURN to continue or '^' to exit: " R LL:DTIME S SCXABRT='$T!(LL="^")
I 'SCXABRT D HDR
Q
;
MSG ;
;;*NOTE* This section consolidates all encounters into visits, where
;;one visit is all encounters for a patient on a single day. For
;;example, three encounters for a patient on one day, is one visit.
;;$$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXPOV3 6044 printed Apr 09, 2024@21:49:03 Page 2
SCDXPOV3 ; ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 05 Oct 98 8:38 PM
+1 ;;5.3;Scheduling;**73,159,173**;AUG 13, 1993
+2 QUIT
VISIT(SCXDT,SCXP,SCXE,SCXET,SCXV,SCXC) ; Update visit count for this encounter
+1 ; Input:
+2 ; SCXDT - Visit date
+3 ; SCXP - Patients DFN
+4 ; SCXE - Vet Eligibility status of encounter
+5 ; SCXET - Vet. or Non-Vet status
+6 ; SCXV - Category of visit
+7 ; SCXC - C&P status of encounter
+8 ;
+9 ; Variables:
+10 ; SCHL - Current Hierarchy level
+11 ; L1 - Local variable
+12 ;
+13 NEW L1,SCHL
+14 ;
+15 IF $DATA(^TMP("SCDXV",$JOB,"ELG",SCXDT,SCXP))
Begin DoDot:1
+16 SET SCHL=$PIECE(^TMP("SCDXV",$JOB,"ELG",SCXDT,SCXP),U,3)
+17 SET L1=$$ELGPRI^SCDXPOV2(SCXE,SCHL)
+18 if $PIECE(L1,U,2)
SET ^TMP("SCDXV",$JOB,"ELG",SCXDT,SCXP)=SCXE_U_SCXET_U_$PIECE(L1,U)
End DoDot:1
+19 IF '$TEST
SET ^TMP("SCDXV",$JOB,"ELG",SCXDT,SCXP)=SCXE_U_SCXET_U_$PIECE($$ELGPRI^SCDXPOV2(SCXE,0),U)
+20 ;
+21 IF $DATA(^TMP("SCDXV",$JOB,"COV",SCXDT,SCXP))
Begin DoDot:1
+22 SET SCHL=$PIECE(^TMP("SCDXV",$JOB,"COV",SCXDT,SCXP),U,2)
+23 SET L1=$$COVPRI^SCDXPOV2(SCXV,SCHL)
+24 if $PIECE(L1,U,2)
SET ^TMP("SCDXV",$JOB,"COV",SCXDT,SCXP)=SCXV_U_$PIECE(L1,U)
End DoDot:1
+25 IF '$TEST
SET ^TMP("SCDXV",$JOB,"COV",SCXDT,SCXP)=SCXV_U_$PIECE($$COVPRI^SCDXPOV2(SCXV,0),U)
+26 ;
+27 IF SCXC
IF '$DATA(^TMP("SCDXV",$JOB,"CP",SCXDT,SCXP))
Begin DoDot:1
+28 SET ^TMP("SCDXV",$JOB,"CP",SCXDT,SCXP)=1
End DoDot:1
+29 QUIT
+30 ;
WRT ; Call procedures to initialize report data global, build the report global, and then print the report.
+1 ;
+2 ; Variables
+3 ; DVN - Facility number from VASITE
+4 ; DNAME - Facility name from VASITE
+5 ;
+6 NEW SDBDASH,SDASH,DNAME,DVN
+7 SET $PIECE(SDBDASH,"=",75)=""
SET $PIECE(SDASH,"-",15)=""
+8 USE IO
+9 ;
+10 SET DVN=$PIECE($$SITE^VASITE(SCXBEG),U,3)
SET DNAME=$PIECE($$SITE^VASITE(SCXBEG),U,2)
+11 DO INIT^SCDXPOV("VISITS")
DO BLDRPT
DO VISRPT
+12 QUIT
+13 ;
BLDRPT ; Build data global for report. Order through date/patient TMP global, and count the number of unique
+1 ; visits. Increment the appropriate report data global.
+2 ;
+3 ; Variables
+4 ; SCXDT - Date the Visit occurred (Encounter date)
+5 ; SCXP - DFN of patient for this encounter
+6 ; SCX - Node of TMP global visits are being counted from
+7 ; LV1 - Local variable for incremneting report data global
+8 ;
+9 NEW SCXDT,SCXP,SCX,LV1
+10 SET SCXDT=""
+11 ; Count visits for Vet./Non-Vet. eligibility
+12 FOR
SET SCXDT=$ORDER(^TMP("SCDXV",$JOB,"ELG",SCXDT))
if SCXDT'>0
QUIT
Begin DoDot:1
+13 SET SCXP=""
FOR
SET SCXP=$ORDER(^TMP("SCDXV",$JOB,"ELG",SCXDT,SCXP))
if 'SCXP
QUIT
Begin DoDot:2
+14 SET SCX=^TMP("SCDXV",$JOB,"ELG",SCXDT,SCXP)
+15 SET LV1=$PIECE($GET(^TMP("SCDXPOV",$JOB,"VISITS",$SELECT($PIECE(SCX,U,2)="Y":"VELIG",1:"NVELIG"),$PIECE(SCX,U))),U)
+16 SET $PIECE(^TMP("SCDXPOV",$JOB,"VISITS",$SELECT($PIECE(SCX,U,2)="Y":"VELIG",1:"NVELIG"),$PIECE(SCX,U)),U)=LV1+1
End DoDot:2
End DoDot:1
+17 ;
+18 ; Count visits for Category of Visit.
+19 FOR
SET SCXDT=$ORDER(^TMP("SCDXV",$JOB,"COV",SCXDT))
if SCXDT'>0
QUIT
Begin DoDot:1
+20 SET SCXP=""
FOR
SET SCXP=$ORDER(^TMP("SCDXV",$JOB,"COV",SCXDT,SCXP))
if 'SCXP
QUIT
Begin DoDot:2
+21 SET LV1=$PIECE(^TMP("SCDXPOV",$JOB,"VISITS","COV",$PIECE(^TMP("SCDXV",$JOB,"COV",SCXDT,SCXP),U)),U)
+22 SET $PIECE(^TMP("SCDXPOV",$JOB,"VISITS","COV",$PIECE(^TMP("SCDXV",$JOB,"COV",SCXDT,SCXP),U)),U)=LV1+1
End DoDot:2
End DoDot:1
+23 ;
+24 ; Count visits with a type of appt. of C&P
+25 FOR
SET SCXDT=$ORDER(^TMP("SCDXV",$JOB,"CP",SCXDT))
if SCXDT'>0
QUIT
Begin DoDot:1
+26 SET SCXP=""
FOR
SET SCXP=$ORDER(^TMP("SCDXV",$JOB,"CP",SCXDT,SCXP))
if 'SCXP
QUIT
Begin DoDot:2
+27 SET $PIECE(^TMP("SCDXPOV",$JOB,"VISITS","CP"),U)=$PIECE(^TMP("SCDXPOV",$JOB,"VISITS","CP"),U)+1
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
VISRPT ; Print body of the Visit report consolidated by number of visits.
+1 ;
+2 ; Variables
+3 ; SBTT - Subtotal of categories
+4 ; NUM - local counting variable
+5 ; SCDXABRT - Abort Printing (Screen only)
+6 ;
+7 NEW NUM,SBTT,L1
+8 ;
+9 DO HDR
+10 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO VISQ
+11 WRITE !,?5,"VETERAN ELIGIBILITY",!
+12 SET (NUM,SBTT)=0
+13 FOR
SET NUM=$ORDER(^TMP("SCDXPOV",$JOB,"VISITS","VELIG",NUM))
if 'NUM
QUIT
Begin DoDot:1
+14 WRITE !?8,$PIECE(^DIC(8,NUM,0),U),?45,$JUSTIFY($PIECE(^TMP("SCDXPOV",$JOB,"VISITS","VELIG",NUM),U),6)
+15 SET SBTT=+$GET(SBTT)+$PIECE(^TMP("SCDXPOV",$JOB,"VISITS","VELIG",NUM),U)
End DoDot:1
IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO VISQ
+16 ;
+17 WRITE !?42,SDASH,!,?5,"Veteran Sub-Total",?45,$JUSTIFY(SBTT,6)
+18 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO VISQ
+19 ;
+20 WRITE !!,?5,"NON-VETERAN ELIGIBILITY",!
+21 SET (NUM,SBTT)=0
+22 FOR
SET NUM=$ORDER(^TMP("SCDXPOV",$JOB,"VISITS","NVELIG",NUM))
if 'NUM
QUIT
Begin DoDot:1
+23 WRITE !?8,$PIECE(^DIC(8,NUM,0),U),?45,$JUSTIFY($PIECE(^TMP("SCDXPOV",$JOB,"VISITS","NVELIG",NUM),U),6)
+24 SET SBTT=+$GET(SBTT)+$PIECE(^TMP("SCDXPOV",$JOB,"VISITS","NVELIG",NUM),U)
End DoDot:1
IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO VISQ
+25 ;
+26 WRITE !?42,SDASH,!,?5,"Non-Veteran Sub-Total",?45,$JUSTIFY(SBTT,6)
+27 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO VISQ
+28 ;
+29 WRITE !!,?5,"CATEGORY OF VISIT",!
+30 SET (NUM,SBTT)=0
+31 FOR
SET NUM=$ORDER(^TMP("SCDXPOV",$JOB,"VISITS","COV",NUM))
if 'NUM
QUIT
Begin DoDot:1
+32 WRITE !?8,$PIECE($TEXT(VISIT+NUM^SCDXPOV1),";",3),?45,$JUSTIFY($PIECE(^TMP("SCDXPOV",$JOB,"VISITS","COV",NUM),U),6)
+33 SET SBTT=+$GET(SBTT)+$PIECE(^TMP("SCDXPOV",$JOB,"VISITS","COV",NUM),U)
End DoDot:1
IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO VISQ
+34 ;
+35 WRITE !?42,SDASH,!,?5,"Category Sub-Total",?45,$JUSTIFY(SBTT,6)
+36 IF $Y>(IOSL-8)
DO NEWPAGE
if SCXABRT
GOTO VISQ
+37 ;
+38 WRITE !!,?8,"Compensation and Penison appointments are included in the above",!?8,"categories and totals and are shown here for information only"
+39 WRITE !!?8,"COMPENSATION AND PENSION",?45,$JUSTIFY($PIECE(^TMP("SCDXPOV",$JOB,"VISITS","CP"),U),6)
+40 ;
VISQ QUIT
+1 ;
HDR ; Print the report header
+1 ; Variables
+2 ; LINEOUT - Message line for header
+3 ; END - Timeout or Uparrow flag for read
+4 ;
+5 NEW END,LINEOUT,LL,HD1,HD2
+6 ;
+7 WRITE @IOF
+8 SET HD2="VISIT REPORT FOR ACTIVITY TRANSMITTED TO NPCDB"
+9 WRITE !?(IOM-$LENGTH(HD2))/2,HD2
+10 SET HD1="FOR PERIOD "
+11 SET Y=SCXBEG
DO DTS^SDUTL
+12 SET HD1=HD1_Y_" THRU "
+13 SET Y=SCXEND
DO DTS^SDUTL
+14 SET HD1=HD1_Y
+15 WRITE !?2,"Facility: "_DNAME,?(IOM-$LENGTH(HD1))-5,HD1
+16 WRITE !!
+17 FOR LL=0:1
SET LINEOUT=$PIECE($TEXT(MSG+(LL+1)),";;",2)
if LINEOUT["$$END"
QUIT
WRITE !?8,LINEOUT
+18 WRITE !!?48,"VISITS"
+19 WRITE !,SDBDASH
+20 QUIT
+21 ;
NEWPAGE ;
+1 NEW LL
+2 IF IOST?1"C-".E
SET DIR(0)="E"
DO ^DIR
SET SCXABRT='+$GET(Y)
DO CLEAR^SCDXPOV2
+3 ;W !," Press RETURN to continue or '^' to exit: " R LL:DTIME S SCXABRT='$T!(LL="^")
+4 IF 'SCXABRT
DO HDR
+5 QUIT
+6 ;
MSG ;
+1 ;;*NOTE* This section consolidates all encounters into visits, where
+2 ;;one visit is all encounters for a patient on a single day. For
+3 ;;example, three encounters for a patient on one day, is one visit.
+4 ;;$$END
