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

DGPTC.m

Go to the documentation of this file. 
  1. DGPTC ;ALB/MJK - Census Main Options; 15 APR 90 ; 5/11/01 1:15pm
  1.  ;;5.3;Registration;**383,643,702,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  D DT^DICRW S X="DGPTC",DIK="^DOPT("""_X_""","
  1.  G A:$D(^DOPT(X,10))
  1.  S ^DOPT(X,0)="Census Main Options^1N^"
  1.  F I=1:1 S Y=$T(@I) Q:Y=""  S ^DOPT(X,I,0)=$P(Y,";",3,99)
  1.  D IXALL^DIK
  1.  ;
  1. A W !! S DIC="^DOPT(""DGPTC"",",DIC(0)="IQEAM"
  1.  D ^DIC Q:Y<0  D @+Y G A
  1.  ;
  1. 1 ;;Load/Edit PTF Record
  1.  G ^DGPTF
  1.  ;
  1. 2 ;;Release Closed Census Record
  1.  S Y=2 D RTY^DGPTUTL,^DGPTFREL
  1.  Q
  1.  ;
  1. 3 ;;Open Closed Census Record
  1.  S Y=2 D RTY^DGPTUTL,HEL^DGPTFDEL
  1.  K DGADM,DGDOM,DGNHCU,MASD,MASDEV,PARA,DG,DGHEM Q
  1.  ;
  1. 4 ;;Transmit Census Records
  1.  D CLOSE G Q4:'Y
  1.  S Y=2 D RTY^DGPTUTL,^DGPTFTR
  1. Q4 K DGCN,DGCN0 Q
  1.  ;
  1. 5 ;;Re-Open Released/Transmitted Records
  1.  S Y=2 D RTY^DGPTUTL,DREL^DGPTFDEL
  1.  Q
  1.  ;
  1. 6 ;;Census Outputs
  1.  G ^DGPTCO
  1.  ;
  1. 7 ;;Census Date Parameters
  1.  D CHKCUR^DGPTCO1
  1.  K DGDASH W ! D DATE^DGPTCO1 S:Y]"" DIC("B")=Y
  1.  S DIC="^DG(45.86,",DIC(0)="AELMQ" D ^DIC K DIC G Q7:Y<0
  1.  S (D0,DGCN)=+Y D PAR
  1.  ;S DA=DGCN,DIE="^DG(45.86,",DR="[DGPT CENSUS DATE]" D ^DIE K DIE,DR,DQ,DE
  1.  ;I '$D(Y) S D0=DGCN D PAR W !!
  1. Q7 K DGCN,D0,DA Q
  1.  ;
  1. 8 ;;Regenerate Census WorkFile
  1.  D GEN^DGPTCR
  1.  Q
  1.  ;
  1. 9 ;;Send 099 Transmission for Census Record
  1.  D CLOSE G Q9:'Y
  1.  S Y=2 D RTY^DGPTUTL,EN^DGPTF099
  1. Q9 K DGCN,DGCN0 Q
  1.  ;
  1. 10 ;;Close Census Reord
  1.  W ! S DIC="^DGPT(",DIC(0)="AEMZQ",DIC("S")="I '$P(^(0),U,6),$P(^(0),U,11)=1"
  1.  D ^DIC K DIC G Q10:Y<0
  1.  S (DGPTF,PTF)=+Y,DFN=+Y(0) D PM^DGPTUTL,CEN^DGPTC1
  1.  I '$D(DGCST) W !!,*7," >>>> Census transactions are not required for this PTF record." G 10
  1.  I DGCST W !!,*7," >>>> This PTF record is already closed for census. (Census #",$S($D(DGCI):DGCI,1:""),")" G 10
  1.  D UPDT^DGPTUTL:'$P(Y(0),U,4) S DGPTFE=$P(^DGPT(PTF,0),U,4)
  1.  S Y=+$S($D(^DG(45.86,+DGCN,0)):+^(0),1:"") D FMT^DGPTUTL
  1.  S Y=2 D RTY^DGPTUTL
  1.  D CLS^DGPTC1
  1.  I 'DGCST W !!," >>>> Not able to close for census.  Please use 'Load/Edit' option to edit PTF."
  1.  D Q1^DGPTF G 10
  1. Q10 K DG1,DGL,DGADM,DGPTFMT,DFN,PTF,DGPTFE,DGRTY,DGRTY0,DGPTF D KVAR^DGPTC1 Q
  1.  ; 
  1. CLOSE ; -- can we xmit?
  1.  D CEN^DGPTUTL S Y=1
  1.  I 'DGCN W !!?5,*7,"There is currently no active census being conducted." S Y=0 G CLOSEQ
  1.  I DT>$P(DGCN0,U,2) S Y=$P(DGCN0,U,2) X ^DD("DD") W !!?5,*7,"Census Close date has passed (",Y,").",!?5,"No transmissions allowed." S Y=0 G CLOSEQ
  1. CLOSEQ Q
  1.  ;
  1. PAR ; census date parameter profile
  1.  ;  input: D0 := ifn of ^DG(45.86)
  1.  S X="DGPTXCP" X ^%ZOSF("TEST") G PARQ:'$T
  1.  K DGDASH,DXS S $P(DGDASH,"-",81)="",IOP="HOME" D ^%ZIS K IOP
  1.  W @IOF,*13,$E(DGDASH,1,28)," Quick Parameter Profile ",$E(DGDASH,1,27)
  1.  D ^DGPTXCP W !,DGDASH
  1. PARQ K DGDASH,DXS Q