Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCDXPOV1

SCDXPOV1.m

Go to the documentation of this file. 
  1. SCDXPOV1 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ;11/29/99  19:23
  1.  ;;5.3;Scheduling;**73,173**;AUG 13, 1993
  1.  Q
  1. WRT ; Entry point for printing visit reprot
  1.  ;
  1.  ;   Variables:
  1.  ;      DVN     - Division IEN used in VA(389.9, and DG(40.8 for retreiving division name
  1.  ;      DNAME   - Division name for printing on report
  1.  ;      SDASH   - Single dash line for report formatting
  1.  ;      SDBDASH - Double dash line for report formatting
  1.  ;      SCETOT  - Total encounters, Eligibility
  1.  ;
  1.  N DVN,DNAME,SDASH,SDBDASH,SDNM,SCETOT
  1.  S $P(SDASH,"-",40)="",$P(SDBDASH,"=",76)=""
  1.  ;
  1.  U IO
  1.  I 'SCXMD D  G END
  1.  . S DVN=$P($$SITE^VASITE(SCXBEG),U,3),DNAME=$P($$SITE^VASITE(SCXBEG),U,2)
  1.  . D XMTPRT
  1.  ;
  1.  I SCXTFLG D  G END
  1.  . S DVN="TOT",DNAME="FACILITY TOTALS: "_$P($$SITE^VASITE(SCXBEG),U,2)
  1.  . D XMTPRT
  1.  ;
  1.  S DVN=0
  1.  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
  1.  . S DNAME=$S('DNAME:"UNKNOWN "_DVN,'$D(^DG(40.8,DNAME,0)):"UNKNOWN",1:$P(^DG(40.8,DNAME,0),U))
  1.  . S:DVN["TOT" DNAME="FACILITY TOTALS: "_$P($$SITE^VASITE(SCXBEG),U,2)
  1.  . D XMTPRT
  1. END Q
  1.  ;
  1. XMTPRT ;  Print data for visit report
  1.  ;
  1.  ;  Variables
  1.  ;    NUM, LL1   -  Local counters
  1.  ;    SBTT       -  Track subtotals for each category
  1.  ;    LL         -  Temporary holder for encounter status values
  1.  ;
  1.  N LL,SBTT,LL1,NUM,SCETOT
  1.  ;
  1.  D HDR1
  1.  ;
  1.  W !,?5,"VETERAN ELIGIBILITY",!
  1.  K SBTT,LL
  1.  S NUM=0
  1.  F  S NUM=$O(^TMP("SCDXPOV",$J,DVN,"VELIG",NUM)) Q:'NUM  D  I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
  1.  . S LL=^TMP("SCDXPOV",$J,DVN,"VELIG",NUM)
  1.  . 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)
  1.  . F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
  1.  ;
  1.  W !?38,SDASH,!,?5,"Veteran Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
  1.  F LL1=1:1:3 S SCETOT(LL1)=+$G(SCETOT(LL1))+$G(SBTT(LL1))
  1.  I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
  1.  ;
  1.  W !!,?5,"NON-VETERAN ELIGIBILITY",!
  1.  K SBTT,LL
  1.  S NUM=0
  1.  F  S NUM=$O(^TMP("SCDXPOV",$J,DVN,"NVELIG",NUM)) Q:'NUM  D  I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
  1.  . S LL=^TMP("SCDXPOV",$J,DVN,"NVELIG",NUM)
  1.  . 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)
  1.  . F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
  1.  ;
  1.  W !?38,SDASH,!,?5,"Non-Veteran Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
  1.  F LL1=1:1:3 S SCETOT(LL1)=+$G(SCETOT(LL1))+$G(SBTT(LL1))
  1.  I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
  1.  ;
  1.  W !!,?5,"CATEGORY OF VISIT",!
  1.  K SBTT,LL
  1.  S NUM=0
  1.  F  S NUM=$O(^TMP("SCDXPOV",$J,DVN,"COV",NUM)) Q:'NUM  D  I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
  1.  . S LL=^TMP("SCDXPOV",$J,DVN,"COV",NUM)
  1.  . 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)
  1.  . F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
  1.  ;
  1.  W !?38,SDASH,!,?5,"Category Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
  1.  I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
  1.  ;
  1.  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)
  1.  W !?16,"Total: ",SCETOT(1)+SCETOT(2)+SCETOT(3)
  1.  I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
  1.  ;
  1.  W !!,?8,"Compensation and Pension appointments are included in the above",!?8,"categories and totals and are shown here for information only"
  1.  K LL S LL=^TMP("SCDXPOV",$J,DVN,"CP")
  1.  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)
  1.  ;
  1.  I SCXOPT>1&(IOST?1"C-".E) K LL W !," Press RETURN to continue or '^' to exit: " R LL:DTIME S SCXABRT='$T!(LL="^")
  1.  ;
  1. XMTQ Q
  1.  ;
  1. HDR1 ;   Print report header and column headers
  1.  N HD2,HD1
  1.  W @IOF
  1.  S HD1="ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
  1.  W !?(IOM-$L(HD1))/2,"ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
  1.  S HD2="FOR PERIOD "
  1.  S Y=SCXBEG D DTS^SDUTL
  1.  S HD2=HD2_Y_" THRU "
  1.  S Y=SCXEND D DTS^SDUTL
  1.  S HD2=HD2_Y
  1.  W !?2,DNAME,$S(DVN'["TOT"&SCXMD:" DIVISION",1:""),?(IOM-$L(HD2))-5,HD2
  1.  W !!,?54,"ENCOUNTERS",!?38,SDASH
  1.  W !?40,"WAITING",?51,"TRANSMITTED",?65,"ACKNOWLEDGED"
  1.  W !?2,SDBDASH
  1.  Q
  1.  ;
  1. NEWPAGE ;
  1.  I IOST?1"C-".E S DIR(0)="E" D ^DIR S SCXABRT='+$G(Y) D CLEAR^SCDXPOV2
  1.  I 'SCXABRT D HDR1
  1.  Q
  1.  ;
  1. VISIT ;  Category of visits  Displayed value/Stored value
  1.  ;;SCHEDULED VISIT;APPOINTMENT
  1.  ;;UNSCHEDULED VISIT;STOP CODE ADDITION
  1.  ;;10 - 10;DISPOSITION