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

DGENACL1.m

Go to the documentation of this file. 
  1. DGENACL1 ;ALB/MRY - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1.  ;
  1. PRINT N DGLN,PAGE,QUIT,DGTOTAL
  1.  S QUIT=""
  1.  U IO
  1.  I $E(IOST,1,2)="C-" D EN^DDIOL("","","@IOF")
  1.  S DGLN=0
  1.  S PAGE=1
  1.  D HEADER:'DGPFTFLG
  1.  D DATA
  1.  I DGLN=0 D
  1.  . D EN^DDIOL("No data to report.","","!!!?30")
  1.  . I $E(IOST,1,2)="C-" D PAUSE
  1.  I ('DGPFTFLG),(DGLN>0),('QUIT) D SUMARY
  1.  Q
  1.  ;
  1.  N DG1,DG2,Y
  1.  I DGRPT=1 D
  1.  . D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST CALL LIST","","!?15")
  1.  . S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
  1.  . D EN^DDIOL("Page: "_PAGE,"","!?60")
  1.  . D:DGPFTFLG EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!") D EN^DDIOL("","","!!")
  1.  . I ($G(DGFMT1)="S") D
  1.  . . D EN^DDIOL("1010EZ APPT.","","?30"),EN^DDIOL("REQ","","?45"),EN^DDIOL("RESIDENCE","","?52"),EN^DDIOL("CELLULAR","","?67")
  1.  . . D EN^DDIOL("NAME(SSN)"),EN^DDIOL("REQUEST DATE","","?30"),EN^DDIOL("STA","","?45"),EN^DDIOL("PHONE","","?54"),EN^DDIOL("PHONE","","?68")
  1.  . . D EN^DDIOL("","","!")
  1.  I DGRPT=2 D
  1.  . S Y=DGBEG D DD^%DT S DG1=Y
  1.  . S Y=DGEND D DD^%DT S DG2=Y
  1.  . D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST TRACKING REPORT","","!?10")
  1.  . S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
  1.  . D EN^DDIOL(DG1_" TO "_DG2,"","!?20"),EN^DDIOL("Page: "_PAGE,"","?60")
  1.  . D:DGPFTFLG EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!")
  1.  . I ($G(DGFMT2)="D") D
  1.  . . D EN^DDIOL("1010EZ APPT.","","!!?37"),EN^DDIOL("SCHEDULED","","?54"),EN^DDIOL("#","","?71"),EN^DDIOL("REQ","","?76")
  1.  . . D EN^DDIOL("NAME"),EN^DDIOL("EP/CV","","?31"),EN^DDIOL("REQUEST DATE","","?37"),EN^DDIOL("APPOINTMENT DATE","","?51"),EN^DDIOL("DAYS","","?70"),EN^DDIOL("STA","","?76")
  1.  . . D EN^DDIOL("============================"),EN^DDIOL("=====","","?31"),EN^DDIOL("============","","?37"),EN^DDIOL("==================","","?51"),EN^DDIOL("====","","?70"),EN^DDIOL("===","","?76")
  1.  I +DGERROR D  Q
  1.  . D EN^DDIOL($P(DGERROR,"^",2),"","!!!")
  1.  . I $E(IOST,1,2)="C-" D PAUSE
  1.  S PAGE=PAGE+1
  1.  Q
  1. DATA ;
  1.  N DFN,DGNAM,DGSSN,DGI,DATAEP,DGFLG,DGRDTI,DGDAYS,DFNIEN,SDADTI,SDADT,DGDAYS,DGENPRI,DGENCVEL,DATA3,DGSTA
  1.  F DGI="C","E","F","I","NULL" S DGTOTAL(DGI)=0
  1.  S DGPFTF=""
  1.  F  S DGPFTF=$O(^TMP($J,"DGEN NEACL",DGPFTF)) Q:(DGPFTF="")  D  Q:QUIT
  1.  . I DGPFTFLG F DGI="C","E","F","I","NULL" S DGTOTAL(DGI)=0
  1.  . D TOP:((DGPFTFLG)&(PAGE>1)) D HEADER:((DGPFTFLG)&(PAGE=1))
  1.  . S DGI=0
  1.  . F  S DGI=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI)) Q:(DGI="")  D  Q:QUIT
  1.  .. S DGRDTI=0 F  S DGRDTI=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI)) Q:'DGRDTI  D  Q:QUIT
  1.  ... S DGNAM="" F  S DGNAM=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM)) Q:DGNAM=""  D  Q:QUIT
  1.  .... S DFNIEN="" F  S DFNIEN=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN)) Q:DFNIEN=""  D  Q:QUIT
  1.  ..... S SDADTI=$G(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN))
  1.  ..... S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I") I DGSTA="" S DGSTA="NULL"
  1.  ..... I DGSTA="C" S SDADTI=$$GET1^DIQ(2,DFNIEN,1010.162,"I")
  1.  ..... S DGDAYS=$$DAYS(SDADTI,DGRDTI) S Y=SDADTI X ^DD("DD") S SDADT=Y
  1.  ..... S DGFLG=0 I 'SDADTI S DGFLG=1
  1.  ..... S DATAEP=$G(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN,"PRIORITY"))
  1.  ..... S DGENPRI=$P(DATAEP,"^",3),DGENCVEL=$P(DATAEP,"^",4)
  1.  ..... S DATA3="/" S:+DGENPRI $P(DATA3,"/")=$E("  ",$L(+DGENPRI)+1,2)_+DGENPRI S:DGENCVEL $P(DATA3,"/",2)="EL" I DATA3="/" S DATA3=""
  1.  ..... S DGTOTAL(DGSTA)=DGTOTAL(DGSTA)+1
  1.  ..... D ADD I '(QUIT) D LINE
  1.  . I DGPFTFLG D SUMARY I $E(IOST,1,2)="C-" D PAUSE
  1.  Q
  1. PAUSE ;
  1.  N DIR,DIRUT,X,Y
  1.  F  Q:$Y>(IOSL-3)  W !
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  I ('(+Y))!($D(DIRUT)) S QUIT=1
  1.  Q
  1. TOP ;
  1.  D EN^DDIOL("","","@IOF")
  1.  D HEADER
  1.  Q
  1. ADD ;
  1.  I $E(IOST,1,2)="C-",($Y>(IOSL-3)) D
  1.  . D PAUSE
  1.  . Q:QUIT
  1.  . D TOP
  1.  I $E(IOST,1,2)'="C-",($Y>(IOSL-3)) D TOP
  1.  Q
  1. LINE ;add a line to the report
  1.  N DGNAMX,DPTDFN,DGCMT
  1.  I DGRPT=2 S DGNAMX=$P(DGNAM,",")
  1.  E  S DGNAMX=DGNAM
  1.  S DGNAMX=DGNAMX_"("_$E($$GET1^DIQ(2,DFNIEN,.09),6,9)_")"
  1.  I DGRPT=1,($G(DGFMT1)="D") D
  1.  . D EN^DDIOL(DGNAMX,"","!") D ADD Q:QUIT
  1.  . S (Y,DPTDFN)=DFNIEN
  1.  . I $$TESTPAT^VADPT(+Y) D EN^DDIOL("WARNING : You have selected a test patient."),ADD Q:QUIT
  1.  . I $$BADADR^DGUTL3(+Y) D EN^DDIOL("WARNING : ** This patient has been flagged with a Bad Address Indicator."),ADD Q:QUIT
  1.  . I $D(^DPT("AXFFP",1,+Y)) S DGCLIST=1 D FFP^DPTLK5 K DGCLIST D ADD Q:QUIT
  1.  . D ENR^DPTLK,ADD Q:QUIT
  1.  . D CV^DPTLK,ADD Q:QUIT
  1.  . D EN^DDIOL("1010EZ APPT. REQUEST DATE: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?28") D ADD Q:QUIT
  1.  . D EN^DDIOL("REQUEST STATUS: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161),"","?18") D ADD Q:QUIT
  1.  . D EN^DDIOL("COMMENT: "_$$GET1^DIQ(2,DFNIEN,1010.163)) D ADD Q:QUIT
  1.  . D EN^DDIOL("PHONE [RESIDENCE]: "_$$GET1^DIQ(2,DFNIEN,.131))
  1.  . D EN^DDIOL("PHONE [CELLULAR]: "_$$GET1^DIQ(2,DFNIEN,.134),"","?44") D ADD Q:QUIT
  1.  . D EN^DDIOL("PREFERRED FACILITY: "_DGPFTF) D ADD Q:QUIT
  1.  . ;D EN^DDIOL("PREFERRED FACILITY: "_$$GET1^DIQ(2,DFNIEN,27.02)) D ADD Q:QUIT
  1.  . D EN^DDIOL("---------------------------------------------------------------","","!?4") D ADD Q:QUIT
  1.  I DGRPT=1,($G(DGFMT1)="S") D  Q:QUIT
  1.  . D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
  1.  . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?30")
  1.  . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?46")
  1.  . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.131),"","?51")
  1.  . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.134),"","?66")
  1.  . D ADD Q:QUIT
  1.  I DGRPT=2,($G(DGFMT2)="D") D
  1.  . D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
  1.  . D EN^DDIOL(DATA3,"","?31"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?37"),EN^DDIOL(SDADT,"","?51"),EN^DDIOL($J(DGDAYS,3)_$S(DGFLG:"*",1:""),"","?71"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?77") D ADD Q:QUIT
  1.  . S DGCMT=$$GET1^DIQ(2,DFNIEN,1010.163) I $G(DGCMT)'="" D EN^DDIOL("COMMENT: "_DGCMT,"","!?3") D ADD Q:QUIT
  1.  S DGLN=1
  1.  Q
  1.  ;
  1. SUMARY ;display totals
  1.  ;K DGFMT1 S DGFMT2="S"
  1.  D ADD2 Q:QUIT
  1.  D EN^DDIOL("SUMMARY","","!!!")
  1.  D EN^DDIOL("==============================================================================")
  1.  S DGI="" F  S DGI=$O(DGTOTAL(DGI)) Q:DGI=""  D
  1.  . I (DGRPT=1)&((DGI="C")!(DGI="F")) Q
  1.  . D EN^DDIOL("Total number of veteran's "_$S(DGI="NULL":"",1:"with ")_$S(DGI="C":"CANCELLED",DGI="E":"EWL",DGI="F":"FILLED",DGI="I":"CONTACTED - IN PROCESS",1:"PENDING ACTION")_$S(DGI="NULL":"",1:" request status"))
  1.  . D EN^DDIOL($J(DGTOTAL(DGI),4),"","?73")
  1.  Q
  1.  ;
  1. ADD2 ;
  1.  I $E(IOST,1,2)="C-",($Y>(IOSL-8)) D
  1.  . D PAUSE
  1.  . Q:QUIT
  1.  . D TOP
  1.  I $E(IOST,1,2)'="C-",($Y>(IOSL-8)) D TOP
  1.  Q
  1. DAYS(X1,X2) ;Compute # of days
  1.  S X1=$G(X1),X2=$G(X2)
  1.  I X1="" S X1=DT
  1.  D ^%DTC
  1.  Q X
  1. Q Q