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

SDRRCRR.m

Go to the documentation of this file. 
  1. SDRRCRR ;10N20/MAH;clinic recall list report; 11/8/2006
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1. STR K DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT,Q,X
  1.  S DIR(0)="SO^1:All Clinics;2:Selected Clinics;3:Selected Team"
  1.  W ! S DIR("A")="Please select what type of Clinic Recall List you are looking for"
  1.  D ^DIR G:$D(DUOUT)!($D(DTOUT)!($D(DIRUT))) QUIT S Q=Y
  1.  I Q=1 K DIR D DATE,EN G QUIT
  1.  I Q=2 K DIR D DATE,EN1 G QUIT
  1.  I Q=3 K DIR D DATE G EN2^SDRRCRR1
  1. DATE ;SETS UP TO FROM DATE AND WILL GROUP BY MONTH IF SELECTED MULTIPLE MONTHS
  1.  S %DT="AEX",%DT("A")="Start with Recall Date First: " D ^%DT G:Y<0 STR S SDT=Y K Y
  1.  S %DT("A")="Recall Date Lasted: " D ^%DT I Y<SDT W $C(7),"  Can't be before Recall Date First - Try Again" G DATE
  1.  Q:Y<0  S EDT=Y K Y
  1.  Q
  1. EN ;all clinics by division
  1.  Q:'$D(SDT)
  1.  W ! S SDEND=1 D ASK2^SDDIV G:Y<0 QUIT
  1.  I VAUTD=1 G ENDIV
  1.  I VAUTD=0 G ONDIV
  1.  Q
  1. ENDIV ;
  1.  W !!,"***This report requires 132 columns",!! S %ZIS="QM" D ^%ZIS G:POP QUIT
  1.  I $D(IO("Q")) S ZTDESC="Print Recall List for Division",ZTRTN="EDIV^SDRRCRR" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. EDIV K ^TMP($J,"ENDIV")
  1.  S (PRO,PRO1,PRO2,RDT,CDT,CDT1,PAT,PHONE,CLINIC,COMMENT)=""
  1.  S ZPR=0 F  S ZPR=$O(^SD(403.5,"C",ZPR)) Q:ZPR=""  S DIV=$P($G(^SD(403.54,ZPR,0)),"^",3) S D0=0 F  S D0=$O(^SD(403.5,"C",ZPR,D0)) Q:D0=""  S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
  1.  .S RDT=$P($G(DTA),"^",6) Q:RDT=""
  1.  .Q:RDT<SDT!(RDT>EDT)
  1.  .S MONTH=$E(RDT,4,5),YR=$E(RDT,2,3)
  1.  .S CLINIC=$P($G(DTA),"^",2) I CLINIC'="" S CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
  1.  .I CLINIC="" S CLINIC="Unknown Clinic"  ;CLINIC
  1.  .S Y=RDT D DD^%DT S DATE=Y K Y  ;RECALL DATE
  1.  .S PAT=$P($G(DTA),"^",1)
  1.  .Q:$$TESTPAT^VADPT(PAT)
  1.  .S DFN=PAT
  1.  .D ADD^VADPT,DEM^VADPT
  1.  .S LN=$E(VADM(1),1)_$P(VA("BID"),U)
  1.  .S PAT1=$P(VADM(1),U)
  1.  .S (CDT,CDT1)="",Y=$P($G(DTA),"^",10) I Y'="" D DD^%DT S CDT=Y K Y D
  1.  ..S Z=$P($G(DTA),"^",13) I Z'=""
  1.  ..S CDT1="*"_CDT K Z
  1.  ..I CDT1'="" S CDT=CDT1
  1.  .I CDT="" S CDT="NotSent"
  1.  .S PHONE=$P(VAPA(8),U)
  1.  .I PHONE="" S PHONE="Unk. Phone"  ;phone
  1.  .S COMMENT=$P($G(DTA),"^",7)
  1.  .S PRO=$P($G(DTA),"^",5) I PRO'="" S PRO1=$P($G(^SD(403.54,PRO,0)),"^",1)
  1.  .I PRO1'="" S PRO2=$$NAME^XUSER(PRO1,"F")
  1.  .I PRO="" S PRO2="Unk. Provider"
  1.  .S USER=$P($G(DTA),"^",11) I USER'="" S USER1=$$NAME^XUSER(USER)
  1.  .I USER="" S USER1="Unk. User"
  1.  .S ^TMP($J,"ENDIV",DIV,CLINIC,PRO2,MONTH,RDT,PAT1)=CLINIC_"^"_PRO2_"^"_DATE_"^"_CDT_"^"_PAT1_"^"_PHONE_"^"_COMMENT_"^"_USER1_"^"_LN
  1.  .K CLINIC,USER,PRO,PAT,RDT,CDT,CDT1
  1.  D PRT1^SDRRCRRP
  1.  D ^%ZISC
  1.  G QUIT
  1. ONDIV ;
  1.  W !!,"***This report requires 132 columns",!! S %ZIS="QM" D ^%ZIS G:POP QUIT
  1.  I $D(IO("Q")) S ZTIO=ION,ZTDESC="Print Recall List for Division",ZTRTN="ONDIV1^SDRRCRR" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. ONDIV1 ;
  1.  K ^TMP($J,"ONDIV")
  1.  U IO
  1.  S (PRO,RDT,CDT,CDT1,PAT,PHONE,CLINIC,COMMENT)=""
  1.  S DIV=0
  1.  F  S DIV=$O(VAUTD(DIV)) Q:DIV=""  D
  1.  .S ZPR=0 F  S ZPR=$O(^SD(403.5,"C",ZPR)) Q:ZPR=""  I $P($G(^SD(403.54,ZPR,0)),"^",3)=DIV S D0=0 F  S D0=$O(^SD(403.5,"C",ZPR,D0)) Q:D0=""  S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
  1.  ..S RDT=$P($G(DTA),"^",6) Q:RDT=""
  1.  ..Q:RDT<SDT!(RDT>EDT)
  1.  ..S MONTH=$E(RDT,4,5),YR=$E(RDT,2,3)
  1.  ..S CLINIC=$P($G(DTA),"^",2) I CLINIC'="" S CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
  1.  ..I CLINIC="" S CLINIC="Unknown Clinic"  ;CLINIC
  1.  ..S Y=RDT D DD^%DT S DATE=Y K Y  ;RECALL DATE
  1.  ..S PAT=$P($G(DTA),"^",1)
  1.  ..Q:$$TESTPAT^VADPT(PAT)
  1.  ..S DFN=PAT
  1.  ..D ADD^VADPT,DEM^VADPT
  1.  ..S LN=$E(VADM(1),1)_$P(VA("BID"),U)
  1.  ..S PAT1=$P(VADM(1),U)
  1.  ..S (CDT,CDT1)="",Y=$P($G(DTA),"^",10) I Y'="" D DD^%DT S CDT=Y K Y
  1.  ..S Z=$P($G(DTA),"^",13) I Z'="" S CDT1="*"_CDT K Z D
  1.  ...I CDT1'="" S CDT=CDT1
  1.  .. I CDT="" S CDT="NotSent"
  1.  ..S PHONE=$P(VAPA(8),U)
  1.  ..I PHONE="" S PHONE="Unk. Phone"  ;phone
  1.  ..S COMMENT=$P($G(DTA),"^",7)
  1.  ..S PRO=$P($G(DTA),"^",5) I PRO'="" S PRO1=$P($G(^SD(403.54,PRO,0)),"^",1),PRO2=$$NAME^XUSER(PRO1,"F")
  1.  ..I PRO="" S PRO2="Unk. Provider"
  1.  ..S USER=$P($G(DTA),"^",11) I USER'="" S USER1=$$NAME^XUSER(USER)
  1.  ..I USER="" S USER1="Unk. User"
  1.  ..S ^TMP($J,"ONDIV",DIV,CLINIC,PRO2,MONTH,RDT,PAT1)=CLINIC_"^"_PRO2_"^"_DATE_"^"_CDT_"^"_PAT1_"^"_PHONE_"^"_COMMENT_"^"_USER1_"^"_LN
  1.  ..K CLINIC,USER,PRO,PAT,RDT,CDT,CDT1
  1.  D PRT^SDRRCRRP
  1.  D ^%ZISC
  1.  G QUIT
  1. EN1 ;BY CLINIC SELECTED CLINIC
  1.  Q:'$D(SDT)
  1.  N VAUTSTR,VAUTVB
  1.  S DIC="^SC(",VAUTVB="VAUTC",VAUTSTR="clinic",VAUTNI="1"     ;G FIRST^VAUTOMA
  1.  S DIC(0)="EQMNZ",DIC("A")="Select "_VAUTSTR_": " K @VAUTVB S (@VAUTVB,Y)=0
  1. REDO N VAERR,VAI,VAUTNALL,VAUTX
  1.  W !,DIC("A") W:'$D(VAUTNALL) "ALL// " R X:DTIME G QUIT:(X="^")!'$T D:X["?" QQ I X="" G:$D(VAUTNALL) QUIT S @VAUTVB=1 G CLIN
  1.  S DIC("A")="Select another "_VAUTSTR_": " D ^DIC G:Y'>0 REDO D SET
  1.  F VAI=1:0:19 W !,DIC("A") R X:DTIME G QUIT:(X="^")!'$T K Y Q:X=""  D QQ:X["?" S:$E(X)="-" VAUTX=X,X=$E(VAUTX,2,999) D ^DIC I Y>0 D SET G:VAX REDO S:'VAERR VAI=VAI+1
  1. CLIN ;
  1.  I VAUTC=1 G ENCLIN
  1.  I VAUTC=0 G ONCLIN
  1.  Q
  1. QQ W !!,"Please select up to 20 clinics that you would like to print"
  1.  Q
  1. ONCLIN  W !!,"***This report requires 132 columns",!! S %ZIS="QM" D ^%ZIS G:POP QUIT
  1.  I $D(IO("Q")) S ZTIO=ION,ZTDESC="Print Recall List for Clinics",ZTRTN="ONCLIN1^SDRRCRR" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. ONCLIN1 ;
  1.  K ^TMP($J,"ONCLIN")
  1.  S (PRO,RDT,CDT,CDT1,PAT,PHONE,CLINIC,COMMENT)=""
  1.  S DIV=0
  1.  F  S DIV=$O(VAUTC(DIV)) Q:DIV=""  S ZPR=$P(VAUTC(DIV),"^",1) D
  1.  .S D0=0 F  S D0=$O(^SD(403.5,"E",ZPR,D0)) Q:D0=""  S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
  1.  ..S RDT=$P($G(DTA),"^",6) Q:RDT=""
  1.  ..Q:RDT<SDT!(RDT>EDT)
  1.  ..S MONTH=$E(RDT,4,5),YR=$E(RDT,2,3)
  1.  ..S CLINIC=$P($G(DTA),"^",2) Q:CLINIC'=ZPR  I CLINIC'="" S CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
  1.  ..I CLINIC="" S CLINIC="Unknown Clinic"  ;CLINIC
  1.  ..S Y=RDT D DD^%DT S DATE=Y K Y  ;RECALL DATE
  1.  ..S PAT=$P($G(DTA),"^",1)
  1.  ..Q:$$TESTPAT^VADPT(PAT)
  1.  ..S DFN=PAT
  1.  ..D ADD^VADPT,DEM^VADPT
  1.  ..S LN=$E(VADM(1),1)_$P(VA("BID"),U)
  1.  ..S PAT1=$P(VADM(1),U)
  1.  ..S CDT="",Y=$P($G(DTA),"^",10) I Y'="" D DD^%DT S CDT=Y K Y
  1.  ..S Z=$P($G(DTA),"^",13) I Z'="" S CDT1="*"_CDT K Z D
  1.  ...I CDT1'="" S CDT=CDT1
  1.  ..I CDT="" S CDT="NotSent"
  1.  ..S PHONE=$P(VAPA(8),U)
  1.  ..I PHONE="" S PHONE="Unk. Phone"  ;phone
  1.  ..S COMMENT=$P($G(DTA),"^",7)
  1.  ..S PRO=$P($G(DTA),"^",5) I PRO'="" S PRO1=$P($G(^SD(403.54,PRO,0)),"^",1),PRO2=$$NAME^XUSER(PRO1,"F")
  1.  ..I PRO="" S PRO2="Unk. Provider"
  1.  ..S USER=$P($G(DTA),"^",11) I USER'="" S USER1=$$NAME^XUSER(USER)
  1.  ..I USER="" S USER1="Unk. User"
  1.  ..S ^TMP($J,"ONCLIN",DIV,CLINIC,PRO2,MONTH,RDT,PAT1)=CLINIC_"^"_PRO2_"^"_DATE_"^"_CDT_"^"_PAT1_"^"_PHONE_"^"_COMMENT_"^"_USER1_"^"_LN
  1.  ..K CLINIC,USER,PRO,PAT,RDT,CDT,CDT1
  1.  D PRT2^SDRRCRRP
  1.  D ^%ZISC
  1.  G QUIT
  1.  ;by division works fine
  1. ENCLIN  W !!,"***This report requires 132 columns",!! S %ZIS="QM" D ^%ZIS Q:POP 
  1.  I $D(IO("Q")) D ^%ZIS G:POP QUIT S ZTIO=ION,ZTDESC="Print Recall List for Clinics",ZTRTN="ENCLIN1^SDRRCRR" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
  1. ENCLIN1 ;
  1.  K ^TMP($J,"ENCLIN")
  1.  S (PRO,RDT,CDT,CDT1,PAT,PHONE,CLINIC,COMMENT)=""
  1.  S ZPR=0 F  S ZPR=$O(^SD(403.5,"E",ZPR)) Q:ZPR=""  S D0=0 F  S D0=$O(^SD(403.5,"E",ZPR,D0)) Q:D0=""  S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
  1.  .S RDT=$P($G(DTA),"^",6) Q:RDT=""
  1.  .Q:RDT<SDT!(RDT>EDT)
  1.  .S MONTH=$E(RDT,4,5),YR=$E(RDT,2,3)
  1.  .S CLINIC=$P($G(DTA),"^",2),DIV=CLINIC I CLINIC'="" S CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
  1.  .I DIV="" S DIV="Unknown"
  1.  .I CLINIC="" S CLINIC="Unknown Clinic"  ;CLINIC
  1.  .S Y=RDT D DD^%DT S DATE=Y K Y  ;RECALL DATE
  1.  .S PAT=$P($G(DTA),"^",1)
  1.  .Q:$$TESTPAT^VADPT(PAT)
  1.  .S DFN=PAT
  1.  .D ADD^VADPT,DEM^VADPT
  1.  .S LN=$E(VADM(1),1)_$P(VA("BID"),U)
  1.  .S PAT1=$P(VADM(1),U)
  1.  .S (CDT,CDT1)="",Y=$P($G(DTA),"^",10) I Y'="" D DD^%DT S CDT=Y K Y
  1.  .S Z=$P($G(DTA),"^",13) I Z'="" S CDT1="*"_CDT K Z D
  1.  ..I CDT1'="" S CDT=CDT1
  1.  .I CDT="" S CDT="NotSent"
  1.  .S PHONE=$P(VAPA(8),U)
  1.  .I PHONE="" S PHONE="Unk. Phone"  ;phone
  1.  .S COMMENT=$P($G(DTA),"^",7)
  1.  .S PRO=$P($G(DTA),"^",5) I PRO'="" S PRO1=$P($G(^SD(403.54,PRO,0)),"^",1),PRO2=$$NAME^XUSER(PRO1,"F")
  1.  .I PRO="" S PRO2="Unk. Provider"
  1.  .S USER=$P($G(DTA),"^",11) I USER'="" S USER1=$$NAME^XUSER(USER)
  1.  .I USER="" S USER1="Unk. User"
  1.  .S ^TMP($J,"ENCLIN",DIV,CLINIC,PRO2,MONTH,RDT,PAT1)=CLINIC_"^"_PRO2_"^"_DATE_"^"_CDT_"^"_PAT1_"^"_PHONE_"^"_COMMENT_"^"_USER1_"^"_LN
  1.  .K CLINIC,USER,PRO,PAT,RDT,CDT,CDT1
  1.  D PRT3^SDRRCRRP
  1.  D ^%ZISC
  1.   G QUIT
  1.  ;BY CLINICS WORK FINE
  1. SET S VAX=0 I $D(VAUTX) S J=$S(VAUTNI=2:+Y,1:$P(Y(0),"^")) K VAUTX S VAERR=$S($D(@VAUTVB@(J)):0,1:1) W $S('VAERR:"...removed from list...",1:"...not on list...can't remove") Q:VAERR  S VAI=VAI-1 K @VAUTVB@(J) S:$O(@VAUTVB@(0))']"" VAX=1 Q
  1.  S VAERR=0 I $S($D(@VAUTVB@($P(Y(0),U))):1,$D(@VAUTVB@(+Y)):1,1:0) W !?3,*7,"You have already selected that ",VAUTSTR,".  Try again." S VAERR=1
  1.  I VAUTNI=1 S @VAUTVB@($P(Y(0),U))=+Y Q
  1.  I VAUTNI=3 S @VAUTVB@($P(Y(0,0),U))=+Y Q
  1.  S @VAUTVB@(+Y)=$P(Y(0),U) Q
  1. QUIT K DIR,Y,SDT,EDT,X,D0,COMMENT,DATE,DIC,I,DTA,DIV,J,LN,MONTH,PAT1,PHONE,POP,PRO1,PRO2,Q,SDEND,SSN,USER1,%,VAUTC,VAUTD,VA,YR,ZPR,VAUTNI
  1.  K ZTDESC,ZTIO,ZTRTN,ZTSAVE,%DT,%ZIS,DFN,VAX,VADM,VAPA
  1.  D KVAR^VADPT
  1.  Q