Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC14.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCAPMC14.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC14.m	(revision 636)
@@ -1,4 +1,4 @@
 SCAPMC14 ;ALB/REW - Team API's: PTPR ; JUN 30, 1995
- ;;5.3;Scheduling;**41,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41**;AUG 13, 1993
  ;;1.0
 PTPR(SC200,SCDATES,SCPURPA,SCROLEA,SCLIST,SCERR,SCYESCL) ; -- list patients for a pract (scyescl NOT supported)
@@ -67,10 +67,7 @@
  .Q:'SCOK
  .Q:'SCYESCL
- .;S SC44=$P($G(^SCTM(404.57,+SCTP,0)),U,9)
- .;Q:'SC44
- .N CNAME,SC44
- .D SETASCL^SCRPRAC2(SCTP,.CNAME,.SC44)
- .N SCCNT S SCCNT=0
- .F  S SCCNT=$O(SC44(SCCNT)) Q:SCCNT=""  S SCOK=$$PTCL^SCAPMC(SC44(SCCNT),"SCDTPR",.SCLIST,.SCERR)
+ .S SC44=$P($G(^SCTM(404.57,+SCTP,0)),U,9)
+ .Q:'SC44
+ .S SCOK=$$PTCL^SCAPMC(SC44,"SCDTPR",.SCLIST,.SCERR)
 PRACQ Q $G(@SCERR@(0))<1
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC29.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCAPMC29.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC29.m	(revision 636)
@@ -1,4 +1,4 @@
 SCAPMC29 ;ALB/REW - TEAM APIs:CLPT  ; 2/17/00 1:33pm
- ;;5.3;Scheduling;**41,210,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,210**;AUG 13, 1993
  ;;1.0
 CLPT(DFN,SCDATES,SCTEAMA,SCLIST,SCERR) ;clinics for patient
@@ -48,25 +48,25 @@
  .F SCX=1:1 S SCTP=+$G(SCPOSAX(SCX)) Q:'SCTP  S SCPOSA(SCTP)=""
  .S:$D(@SCTEAMA@("EXCLUDE")) SCPOSA("EXCLUDE")=""
- ;S SCX=0 F  S SCX=$O(^DPT(DFN,"DE",SCX)) Q:'SCX  D
- ;.S SC44=+$G(^DPT(DFN,"DE",SCX,0))
- ;.Q:'SC44
- ;.Q:'$$OKCLIN(SC44,.SCPOSA)
- ;.S SCCLNM=$P($G(^SC(SC44,0)),U,1)
- ;.S SCS=0 F  S SCS=$O(^DPT(DFN,"DE",SCX,1,SCS)) Q:'SCS  D
- ;..S SCND=$G(^DPT(DFN,"DE",SCX,1,SCS,0))
- ;..S SCACT=$P(SCND,U,1)
- ;..S SCINACT=$P(SCND,U,3)
- ;..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCACT,SCINACT)
- ;..S SCACOPT=$P(SCND,U,2)
- ;..S SCREVDT=$P(SCND,U,5)
- ;..S SCN=$G(@SCLIST@(0),0)+1
- ;..;bp/ar nois brx-1298-12323 prevent undefined variable error
- ;..;New code begins
- ;..Q:'SCACT
- ;..Q:'SCN
- ;.;End of brx-1298-12323
- ;..S @SCLIST@(0)=SCN
- ;..S @SCLIST@(SCN)=SC44_U_SCCLNM_U_SCACT_U_SCINACT_U_SCACOPT_U_SCREVDT
- ;..S @SCLIST@("SCCL",SC44,SCACT,SCN)=""
+ S SCX=0 F  S SCX=$O(^DPT(DFN,"DE",SCX)) Q:'SCX  D
+ .S SC44=+$G(^DPT(DFN,"DE",SCX,0))
+ .Q:'SC44
+ .Q:'$$OKCLIN(SC44,.SCPOSA)
+ .S SCCLNM=$P($G(^SC(SC44,0)),U,1)
+ .S SCS=0 F  S SCS=$O(^DPT(DFN,"DE",SCX,1,SCS)) Q:'SCS  D
+ ..S SCND=$G(^DPT(DFN,"DE",SCX,1,SCS,0))
+ ..S SCACT=$P(SCND,U,1)
+ ..S SCINACT=$P(SCND,U,3)
+ ..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCACT,SCINACT)
+ ..S SCACOPT=$P(SCND,U,2)
+ ..S SCREVDT=$P(SCND,U,5)
+ ..S SCN=$G(@SCLIST@(0),0)+1
+ ..;bp/ar nois brx-1298-12323 prevent undefined variable error
+ ..;New code begins
+ ..Q:'SCACT
+ ..Q:'SCN
+ ..;End of brx-1298-12323
+ ..S @SCLIST@(0)=SCN
+ ..S @SCLIST@(SCN)=SC44_U_SCCLNM_U_SCACT_U_SCINACT_U_SCACOPT_U_SCREVDT
+ ..S @SCLIST@("SCCL",SC44,SCACT,SCN)=""
 PTCLQ Q $G(@SCERR@(0))<1
  ;
@@ -75,5 +75,5 @@
  IF '$D(SCPOSA) S SCOK=1 G QTOKC
  S (SCOK,SCTP)=0
- F  S SCTP=$O(^SCTM(404.57,"E",+SC44,SCTP)) Q:'SCTP  S:$$OKARRAY^SCAPU1(.SCPOSA,SCTP) SCOK=1
+ F  S SCTP=$O(^SCTM(404.57,"D",+SC44,SCTP)) Q:'SCTP  S:$$OKARRAY^SCAPU1(.SCPOSA,SCTP) SCOK=1
 QTOKC Q SCOK
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC30.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCAPMC30.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC30.m	(revision 636)
@@ -1,4 +1,4 @@
 SCAPMC30 ;ALB/REW - TEAM APIs:TPCL  ; 30 Jun 95
- ;;5.3;Scheduling;**41,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41**;AUG 13, 1993
  ;;1.0
 TPCL(SC44,SCDATES,SCPOSA,SCUSRA,SCPURPA,SCROLEA,SCLIST,SCERR) ;  -- list of positions for a clinic
@@ -58,5 +58,5 @@
  S SCOK=1
  G:'$$OKDATA CLTPQ
- S SCTP=0 F  S SCTP=$O(^SCTM(404.57,"E",SC44,SCTP)) Q:'SCTP  D  Q:'SCOK
+ S SCTP=0 F  S SCTP=$O(^SCTM(404.57,"D",SC44,SCTP)) Q:'SCTP  D  Q:'SCOK
  .S SCTP0=$G(^SCTM(404.57,SCTP,0))
  .IF '$L(SCTP0) D
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC9.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCAPMC9.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC9.m	(revision 636)
@@ -1,4 +1,4 @@
 SCAPMC9 ;ALB/REW - Team API's:PRCL ; JUN 26, 1995
- ;;5.3;Scheduling;**41,112,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,112**;AUG 13, 1993
  ;;1.0
 PRCL(SC44,SCDATES,SCPOSA,SCUSRA,SCROLEA,SCLIST,SCERR) ;-- list of practitioners for clinic
@@ -54,5 +54,5 @@
  ; -- loop through team positions
  S SCTP=0
- F  S SCTP=$O(^SCTM(404.57,"E",SC44,SCTP)) Q:SCTP=""  D
+ F  S SCTP=$O(^SCTM(404.57,"D",SC44,SCTP)) Q:SCTP=""  D
  .Q:'$$OKARRAY^SCAPU1(.SCPOSA,SCTP)
  .S SCND=$G(^SCTM(404.57,SCTP,0))
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCDD2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCDD2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCDD2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCMCDD2 ;ALB/REW - DD Calls used by PCMM ; 27 March 1996
- ;;5.3;Scheduling;**41,107,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,107**;AUG 13, 1993
  ;1
 USEPCDEF(SCCL) ;how should pc practitioner be used for clinic
@@ -24,5 +24,5 @@
  S SCOK=0
  S SCXTP=0
- F  S SCXTP=$O(^SCTM(404.57,"E",SCCL,SCXTP)) Q:('SCXTP)!(SCXTP=SCTP)  D
+ F  S SCXTP=$O(^SCTM(404.57,"D",SCCL,SCXTP)) Q:('SCXTP)!(SCXTP=SCTP)  D
  .I $P(^SCTM(404.57,SCXTP,0),U,2)'=SCTM Q
  .S SCOK=1
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCHLB1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCHLB1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCHLB1.m	(revision 636)
@@ -1,4 +1,4 @@
-SCMCHLB1 ;BPOI/DJB - PCMM HL7 Bld Segment Array Cont.;8/17/99
- ;;5.3;Scheduling;**177,515,524**;08/17/99;Build 29
+SCMCHLB1 ;BP/DJB - PCMM HL7 Bld Segment Array Cont. ; 8/17/99 9:29am
+ ;;5.3;Scheduling;**177,515**;May 01, 1999;Build 14
  ;
 SEGMENTS(DFN,SUB) ;Build EVN & PID segments
@@ -46,13 +46,13 @@
  ;   Array of ZPC segments
  ;
- NEW DATA,DATE,ID,ID1,LINETAG,SUB,TYPE,VAFZPC
+ NEW DATA,DATE,ID,ID1,LINETAG,NUM,TYPE,VAFZPC
  ;
- S SUB=0
- F  S SUB=$O(ARRAY(SUB)) Q:'SUB  D  ;
+ S NUM=0
+ F  S NUM=$O(ARRAY(NUM)) Q:'NUM  D  ;
  . S TYPE=""
- . F  S TYPE=$O(ARRAY(SUB,TYPE)) Q:TYPE=""  D  ;
+ . F  S TYPE=$O(ARRAY(NUM,TYPE)) Q:TYPE=""  D  ;
  .. S ID=""
- .. F  S ID=$O(ARRAY(SUB,TYPE,ID)) Q:ID=""  D  ;
- ... S DATA=$G(ARRAY(SUB,TYPE,ID))
+ .. F  S ID=$O(ARRAY(NUM,TYPE,ID)) Q:ID=""  D  ;
+ ... S DATA=$G(ARRAY(NUM,TYPE,ID))
  ... I $G(DELETE) S DATA="^^^" ;A Delete type ZPC segment
  ... E  D  ;....................A ZPC segment with data
@@ -74,6 +74,8 @@
  ....S DATA=DATA_"^"_ROLE
  ... ;
- ... D BLDZPC^SCMCHLS ;..Build segment ; og/sd/524
- ... D CPYZPC^SCMCHLS ;..Copy segment into array ; og/sd/524
+ ... S LINETAG="BLDZPC"
+ ... D @LINETAG^SCMCHLS ;..Build segment
+ ... S LINETAG="CPYZPC"
+ ... D @LINETAG^SCMCHLS ;..Copy segment into array
  Q
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCHLB2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCHLB2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCHLB2.m	(revision 636)
@@ -1,4 +1,4 @@
-SCMCHLB2 ;BPOI/DJB - PCMM HL7 Bld Segment Array Deletes;3/6/00
- ;;5.3;Scheduling;**177,204,210,224,524**;08/13/93;Build 29
+SCMCHLB2 ;BP/DJB - PCMM HL7 Bld Segment Array Deletes ; 3/6/00 8:41am
+ ;;5.3;Scheduling;**177,204,210,224**;AUG 13, 1993
  ;
 PTP ;Entry has been deleted from file 404.43. Send deletes to NPCD.
@@ -20,6 +20,5 @@
  S ID=PTPI_"-"
  F  S ID=$O(^SCPT(404.49,"B",ID)) Q:ID=""!($P(ID,"-",1)'=PTPI)  D  ;
- . N SUB  ; og/sd/524
- . S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment
+ . S DATA="^^^" ;........A Delete type ZPC segment
  . ;djb/bp Patch 210. Eliminate indirection[rel 204]
  . D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA)
@@ -65,6 +64,5 @@
  .. S ID=""
  .. F  S ID=$O(@POS@(DFN,PTPI,ID)) Q:ID=""  D  ;djb/bp BIG-1199-71271
- ... N SUB  ; og/sd/524
- ... S SUB=PTPI,DATA="^^^" ;........A Delete type ZPC segment
+ ... S DATA="^^^" ;........A Delete type ZPC segment
  ... ;djb/bp Patch 210. Eliminate indirection[rel 204]
  ... D BLDZPC^SCMCHLS ;..Build segment (needs ID & DATA)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCHLS.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCHLS.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCHLS.m	(revision 636)
@@ -1,4 +1,4 @@
-SCMCHLS ;BPOI/DJB - PCMM HL7 Segment Utils;12/13/99
- ;;5.3;Scheduling;**177,210,212,293,515,524**;08/13/93;Build 29
+SCMCHLS ;BP/DJB - PCMM HL7 Segment Utils ; 12/13/99 12:40pm
+ ;;5.3;Scheduling;**177,210,212,293,515**;AUG 13, 1993;Build 14
  ;
  ;Ref rtn: SCDXMSG1
@@ -37,5 +37,5 @@
  ; PATCH 515 DLL USE ORIG TRIG 
  ; old code = M @XMITARRY@($P(ID,"-",1),"ZPC",ID)=VAFZPC
- M @XMITARRY@(SUB,"ZPC",ID)=VAFZPC  ; og/sd/524
+ M @XMITARRY@(NUM,"ZPC",ID)=VAFZPC
  Q
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCMU2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCMU2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCMU2.m	(revision 636)
@@ -1,4 +1,4 @@
-SCMCMU2 ;ALBOI/MJK - PCMM Mass Team/Position Unassignment Processing;07/10/98
- ;;5.3;Scheduling;**148,177,524**;AUG 13, 1993;Build 29
+SCMCMU2 ;ALB/MJK - PCMM Mass Team/Position Unassignment Processing ; 10-JUL-1998
+ ;;5.3;Scheduling;**148,177**;AUG 13, 1993
  ;
 QUE() ; -- queue mass unassignment
@@ -169,6 +169,6 @@
  . ; -- if assignment date is in future then delete
  . IF SCASDT>DT,SCASDT>SCDATE D  Q
- . . N DA,DIE,DIK,DR
- . . S DA=SCIEN,(DIE,DIK)="^SCPT(404.43,",DR=".04///"_DT D ^DIE  ; og/sd/524
+ . . N DA,DIK
+ . . S DA=SCIEN,DIK="^SCPT(404.43,"
  . . D LOCK(SCNODE)
  . . D ^DIK
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCPT2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCPT2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCPT2.m	(revision 636)
@@ -1,3 +1,3 @@
-SCMCPT2 ; GENERATED FROM 'SCMC INCONSISTENT' PRINT TEMPLATE (#1448) ; 12/27/06 ; (FILE 404.57, MARGIN=132)
+SCMCPT2 ; GENERATED FROM 'SCMC INCONSISTENT' PRINT TEMPLATE (#1467) ; 12/25/06 ; (FILE 404.57, MARGIN=132)
  G BEGIN
 N W !
@@ -12,5 +12,5 @@
 BEGIN ;
  S:'$D(DN) DN=1 S DISTP=$G(DISTP),DILCT=$G(DILCT)
- I $D(DXS)<9 M DXS=^DIPT(1448,"DXS")
+ I $D(DXS)<9 M DXS=^DIPT(1467,"DXS")
  S I(0)="^SCTM(404.57,",J(0)=404.57
  W ?0 S X=$P($$GETPRTP^SCAPMCU2(D0,DT),U,2) W $E(X,1,8) K Y(404.57,304)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCPT6.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCPT6.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCPT6.m	(revision 636)
@@ -1,3 +1,3 @@
-SCMCPT6 ; GENERATED FROM 'SCMC DIRECT PC FTEE 1 CLN' PRINT TEMPLATE (#1452) ; 12/27/06 ; (FILE 404.52, MARGIN=132)
+SCMCPT6 ; GENERATED FROM 'SCMC DIRECT PC FTEE 1 CLN' PRINT TEMPLATE (#1471) ; 12/25/06 ; (FILE 404.52, MARGIN=132)
  G BEGIN
 CP G CP^DIO2
@@ -21,5 +21,5 @@
 BEGIN ;
  S:'$D(DN) DN=1 S DISTP=$G(DISTP),DILCT=$G(DILCT)
- I $D(DXS)<9 M DXS=^DIPT(1452,"DXS")
+ I $D(DXS)<9 M DXS=^DIPT(1471,"DXS")
  S I(0)="^SCTM(404.52,",J(0)=404.52
  S X=$G(^SCTM(404.52,D0,0)) W ?0 S Y=$P(X,U,3) S Y=$S(Y="":Y,$D(^VA(200,Y,0))#2:$P(^(0),U),1:Y) W $E(Y,1,15)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCQK1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCQK1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCQK1.m	(revision 636)
@@ -1,4 +1,4 @@
-SCMCQK1 ;ALBOI/REW - Single Pt Tm/Pt Tm Pos Assign and Discharge;11/07/02
- ;;5.3;Scheduling;**148,177,231,264,436,297,446,524**;AUG 13, 1993;Build 29
+SCMCQK1 ;ALB/REW - Single Pt Tm/Pt Tm Pos Assign and Discharge ; 07 Oct 2002  12:10 PM  ; Compiled April 12, 2007 10:03:59
+ ;;5.3;Scheduling;**148,177,231,264,436,297,446**;AUG 13, 1993;Build 77
  ;
  ;04/25/2006 SD*5.3*446 INTER-FACILITY TRANSFER
@@ -11,5 +11,5 @@
  G:SCDISCH<1 QTUNTP
  G:'$$CONFIRM() QTUNTP
- S OK=$$INPTSCTP^SCAPMC22(DFN,SCTP,SCDISCH,.SCER)  ; og/sd/524
+ S OK=1 ;$$INPTSCTP^SCAPMC22(DFN,SCTP,SCDISCH,.SCER)
  G:OK'>0 QTUNTP
  S SCCL=$P($G(^SCTM(404.57,+$G(SCTP),0)),U,9)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCTSK1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK1.m	(revision 636)
@@ -1,12 +1,12 @@
-SCMCTSK1 ;ALB/JDS - PCMM Inactivations; 18 Apr 2003  9:36 AM ; 10/24/07 12:24pm  ; Compiled January 25, 2008 12:11:43  ; Compiled March 26, 2008 22:27:26
- ;;5.3;Scheduling;**297,498,527,499**;AUG 13, 1993;Build 21
- Q
-INACTIVE ;
- ;Flag patients
- N I,CNT,SC297,TPZ,TYDT,TEAMN,STDT,Q,SDDT,STDD S CNT=0
- D DT^DICRW
- N SD1 S SDDT="" F SD1=DT,DT-1 I $D(^XTMP("SCMCTSK2-"_SD1,$J,"START")) S SDDT=SD1 Q
- I SDDT'>0 D DT^DICRW S SDDT=DT
- S %DT="",X="T-11M" D ^%DT S STDD=+Y
+SCMCTSK1 ;ALB/JDS - PCMM Inactivations; 18 Apr 2003  9:36 AM ; 10/24/07 12:24pm
+ ;;5.3;Scheduling;**297,498,527**;AUG 13, 1993;Build 6
+ Q
+INACTIVE ;run every night to determine if patient can be inactivated from
+ ;team
+ ;Inactivation happens for patients without activity for 24 months
+ N I,CNT,SC297,TPZ,TYDT,TEAMN,STDT,Q S CNT=0
+ D DT^DICRW S %DT="",X="T-11M" D ^%DT S STDT=Y
+ S SC297=$$PDAT^SCMCGU("SD*5.3*297"),X1=DT,X2=SC297 D D^%DTC S SC297=X
+ S X="T-"_$S(SC297>330:"11M",1:"23M") D ^%DT S TYDT=+Y
  S A="^SCPT(404.43,""ADFN""",L=""""""
  S Q=A_")"
@@ -14,70 +14,56 @@
  .S ENTRY=+$P(Q,",",6)
  .S ZERO=$G(^SCPT(404.43,+ENTRY,0))
- .I $P(ZERO,U,15) Q
  .S POS=+$P(ZERO,U,2)
- .I $P(ZERO,U,4) Q  ;UNASS
- .I '$P(ZERO,U,5) Q  ;Not PC
- .I $P(ZERO,U,3)>STDD Q  ;<11 months
- .I $P(ZERO,U,17) Q  ;React
- .;get preceptor
+ .S TEAM=$P(Q,",",4)
+ .;I $P($G(^SCTM(404.51,+TEAM,0)),U,16) Q  ;no automatic for this team
+ .;I $G(^DPT(DFN,.35)) D DIS Q  ;Patient is deceased
+ .I $P(ZERO,U,3)>STDT Q  ;Later
+ .I $P(ZERO,U,17) Q  ;Already reactivated
+ .;get preceptor position
  .S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS)
+ .;see if provider changed
+ .I $O(^SCTM(404.52,"AIDT",+PREC,1,-STDT),-1) Q
+ .I $P(ZERO,U,4) Q  ;Already unassigned
+ .I '$P(ZERO,U,5) Q  ;Not primary care
+ .;I $P(ZERO,U,16) Q  ;No Automatic unassign
+ .;Check if any activity
  .S DFN=$P(Q,",",3)
  .I $G(XPDIDTOT),('(DFN#5)) D UPDATE^XPDID(DFN)
  .S TEAM=$P(Q,",",4),TEAMNM=$P($G(^SCTM(404.51,+TEAM,0)),U)
- .N STDT S %DT="",X="T-12M" D ^%DT S STDT=+Y
- .;N-new or E-est
- .N NEW
- .I $P(ZERO,U,3)<STDT S NEW=0
- .E  S NEW=1
- .N TYDT
- .I NEW N STDT S %DT="",X="T-11M" D ^%DT S STDT=+Y D
- ..S X1=STDT,X2=-7 D C^%DTC S TYDT=X
- .I 'NEW N STDT S %DT="",X="T-23M" D ^%DT S STDT=+Y Q:$P(ZERO,U,3)'<STDT  D
- ..S X1=STDT,X2=-7 D C^%DTC S TYDT=X
- .N PROV,SEEN,PRECP D SEEN(DFN,POS,TYDT,SDDT,.PROV,.PRECP,.SEEN) Q:SEEN
- .;flag
- .S DIE="^SCPT(404.43,",DR=".15////"_SDDT,DA=ENTRY D ^DIE
- .S TPZ=$G(^SCTM(404.57,+POS,2))
- .I "TP"[$P(TPZ,U,9) I $G(PROV) S CNT=CNT+1,^TMP("SCF",$J,PROV,CNT,ENTRY)=""
- .I $P(TPZ,U,10),$G(PRECP) S CNT=CNT+1,^TMP("SCF",$J,PRECP,CNT,ENTRY)=""
- Q
-SEEN(DFN,POS,TYDT,SDDT,PROV,PROVP,SEEN) ;
- S SEEN=0,PROVP=""
- N SCPRO,I,PRO,X,SCPRDTS,SCPR,PREC
- S PROV=+$$GETPRTP^SCAPMCU2(POS,SDDT)
- S SCPRDTS("BEGIN")=TYDT,SCPRDTS("END")=SDDT,SCPRDTS("INCL")=0
+ .D SEEN Q:SEEN
+ .I '$P(ZERO,U,15) D
+ ..S DIE="^SCPT(404.43,",DR=".15////"_DT,DA=ENTRY D ^DIE
+ ..S TPZ=$G(^SCTM(404.57,+POS,2))
+ ..I "TP"[$P(TPZ,U,10) I $G(PROV) S CNT=CNT+1,^TMP("SCF",$J,PROV,CNT,ENTRY)=""
+ ..I $P(TPZ,U,9),$G(PRECP) S CNT=CNT+1,^TMP("SCF",$J,PRECP,CNT,ENTRY)=""
+ Q
+SEEN ;was patient seen
+ S SEEN=0
+ N SCPRO,I,PRECP,PRO
+ N X,SCPRDTS,SCPR
+ ;get list of providers for this position
+ S PROV=+$$GETPRTP^SCAPMCU2(POS,DT) S SCPRO(+PROV)=""
+ S SCPRDTS("BEGIN")=TYDT
+ S SCPRDTS("END")=DT
  S X=$$PRTP^SCAPMC(POS,"SCPRDTS","SCPR")
- S I=0 F  S I=$O(SCPR(I)) Q:'I  S SCPRO(+SCPR(I))="",SCPRO(+SCPR(I),I)=$P(SCPR(I),U,9,10) D
- .S PREC=$P(SCPR(I),U,12)
- .I PREC,PREC'=POS S PROVP=+$$GETPRTP^SCAPMCU2(PREC,SDDT) S SCPRO(+PROVP)="" S SCPRO(+PROVP,I)=$P(SCPR(I),U,9,10)
+ F I=0:0 S I=$O(SCPR(I)) Q:'I  S SCPRO(+SCPR(I))=""
+ S PRECP=0 I $G(PREC),$G(PREC)'=POS S PRECP=+$$GETPRTP^SCAPMCU2(PREC,DT),SCPRO(+PRECP)=""
  F I=TYDT:0 S I=$O(^SCE("ADFN",DFN,I)) Q:'I  D  Q:SEEN
- .S J=0 F  S J=$O(^SCE("ADFN",DFN,I,J)) Q:'J  D  Q:SEEN
+ .F J=0:0 S J=$O(^SCE("ADFN",DFN,I,J)) Q:'J  D  Q:SEEN
  ..N VISIT S VISIT=+$P($G(^SCE(J,0)),U,5) I $G(^SCE(J,0))<$G(TYDT) Q
- ..S PRO=0 F  S PRO=$O(SCPRO(PRO)) Q:'PRO  D  Q:SEEN
- ...I $D(^SDD(409.44,"AO",J,$G(PRO))) D CHK I SEEN=1 Q
- ...N V F V=0:0 S V=$O(^AUPNVPRV("AD",VISIT,V)) Q:'V  I PRO=(+$G(^AUPNVPRV(V,0))) D CHK I SEEN=1 Q
- Q
-CHK ;
- N SDX S SDX="" F  S SDX=$O(SCPRO(PRO,SDX)) Q:SDX=""  D  Q:SEEN
- .I $P(SCPRO(PRO,SDX),U,2)="" D  Q
- ..I I'<$P(SCPRO(PRO,SDX),U) S SEEN=1
- .I I'<TYDT&(I'>$P(SCPRO(PRO,SDX),U,2)) S SEEN=1
- Q
-DIS ;disch
+ ..F PRO=0:0 S PRO=$O(SCPRO(PRO)) Q:'PRO  D  Q:SEEN
+ ...I $D(^SDD(409.44,"AO",J,$G(PRO))) S SEEN=1 Q  ;GET THE PROVIDERJ
+ ...N V F V=0:0 S V=$O(^AUPNVPRV("AD",VISIT,V)) Q:'V  I PRO=(+$G(^AUPNVPRV(V,0))) S SEEN=1 Q
+ Q
+DIS ;discharge
  N ZERO S ZERO=$G(^SCPT(404.43,+ENTRY,0))
- I $P(ZERO,U,4) Q
+ I $P(ZERO,U,4) Q  ;Already discharged
  D DIS2^SCMCTSK7
  Q
-CHKENR(DATA,INFO) ;check if patient enrolled in teamposition clinic
- S DATA(0)=-1
- Q
-EXTEND(DATA,SCTEAM) ;to inact. in next 60 days
+EXTEND(DATA,SCTEAM) ;return list of patients to inactivate in next 60 days
  ;IEN^POSITION^PATIENT^EXTENDED^REASON
  K DATA,SCDATA,SDDATA
  N CNT,I,J,K,A,POSA S CNT=1 S SCTEAM=$G(SCTEAM),DATA(1)="<DATA>"
- D DT^DICRW
- N SD1 S SDDT="" F SD1=DT,DT-1 I $D(^XTMP("SCMCTSK2-"_SD1,$J,"START")) S SDDT=SD1 Q
- I SDDT'>0 D DT^DICRW S SDDT=DT
- S X="T-9M" D ^%DT S STDT=Y
+ D DT^DICRW S X="T-9M" D ^%DT S STDT=Y
  S X="T-21M" D ^%DT S TYDT=+Y  ;MAKE THIS 21
  S POSA=""
@@ -91,7 +77,7 @@
  .S CNT=CNT+1
  Q
-POS I '$$DATES^SCAPMCU1(404.59,POS) Q  ;Position inact
+POS I '$$DATES^SCAPMCU1(404.59,POS) Q   ;Not an active position
  I '$P($G(^SCTM(404.57,POS,0)),U,4) Q  ;Not PC
- ;patients for position
+ ;get patients for this position
  K ^TMP("SC TMP LIST",$J)
  S X=$$PTTP^SCAPMC(POS,"",.SCLIST,.SCERR)
@@ -101,5 +87,5 @@
  .I '$P($G(^SCPT(404.43,+$P(SCDATA,U,3),0)),U,15) Q
  .S DFN=+SCDATA
- .D SEEN(DFN,POS,TYDT,SDDT,.PROV,.PRECP,.SEEN) Q:SEEN
+ .D SEEN Q:SEEN
  .S SDDATA($P($G(^SCTM(404.57,POS,0)),U),$P(SCDATA,U,2),+SCDATA)=SCDATA,CNT=CNT+1
  K @SCLIST
@@ -107,5 +93,5 @@
 FILE(RES,DATA) ;File data on FTEE
  N I
- F I=1:1 Q:'$D(DATA(I))  D
+ F I=1:1 Q:'$D(DATA(I))   D
  .S $P(DATA(I),U,7)=$TR($P(DATA(I),U,7),"[]")
  .S ZERO=$G(^SCPT(404.43,+DATA(I),0))
@@ -116,5 +102,5 @@
  I $O(FLDA(0)) D FILE^DIE("E","FLDA","ERR")
  Q
-SCREEN ;Active assign. screen
+SCREEN ;Screen for active assignments
  N A S A=$G(^SCTM(404.52,D0,0))
  N J S J=-(DT+1),J=$O(^SCTM(404.52,"AIDT",+A,1,J)) I J="" S X=0 Q
@@ -124,5 +110,5 @@
  I '$D(^SCTM(404.52,"AIDT",+A,1,J,D0)) S X=0 Q
  S X=1 Q
-SUM(PR,POSI) ;get pos for prov
+SUM(PR,POSI) ; get positions for this provider
  N I,INS,ZERO,SCA,TEAM,FTEE,Z
  S I="",FTEE=0
@@ -139,16 +125,16 @@
  .S FTEE=FTEE+$P(ZERO,U,9)
  Q FTEE
-FTEECHK(DATA,PAIEN) ;check Ftee>1
+FTEECHK(DATA,PAIEN) ;check Ftee greater than 1
  N A S A=$G(^SCTM(404.52,+PAIEN,0)),FTEE=$$SUM(+$P(PAIEN,U,3),+A)
  S DATA=0
  S DATA=FTEE+$P(PAIEN,U,2)
  Q
-SORT(DIPA,SDD) ;sort tmpl
- N DIC
+SORT ;sort template
+ N DIC,DIPA
  S DIC=4,DIC(0)="ZME"
  S DIC("S")="I $D(^SCTM(404.51,""AINST"",+Y))"
  S DIR("A")="Start with Institution",DIR("B")="FIRST",DIR(0)="F" D ^DIR
- I X="FIRST" S DIPA("SI")="",DIPA("EI")="zzz",SDD=1 Q
- D ^DIC I Y<0 S DIPA("SI")=X S SDD=X Q:SDD[U  D
+ I X="FIRST" S DIPA("SI")="",DIPA("EI")="zzz",X=1 Q
+ D ^DIC I Y<0 S DIPA("SI")=X Q:X[U  D
  .S DIR("A")="Go to Institutiton",DIR("B")="LAST" S DIR(0)="F" D ^DIR
  .I X="LAST" S DIPA("EI")="zzz"
@@ -156,6 +142,6 @@
  D ^DIC
  I Y>0 S DIPA("EI")=$P(Y(0),U)
- I Y<0 S DIPA("EI")=X S SDD=X Q:SDD[U
- S SDD=1 Q
+ I Y<0 S DIPA("EI")=X Q:X[U
+ S X=1 Q
 FTEERPT ;FTEE REPORT
  D FTERPT^SCMCTSK6 Q
@@ -169,5 +155,5 @@
  S DATA=0
  I ('INFO)!('$P(INFO,U,2)) Q
- ;Is provider role acceptable?
+ ;Check if provider can be in this role.
  S J=-(DT+1) S J=$O(^SCTM(404.52,"AIDT",+INFO,1,J)) Q:J=""
  I $O(^SCTM(404.52,"AIDT",+INFO,0,-(DT+1)))<J Q
@@ -191,22 +177,26 @@
  S SCDFN=+Y W !,SCDFN
 SCDFN S SC1="^SCPT(404.43,""APCPOS"",SCDFN,1)"
- ;quit if no PC assign
+ ;
+ ;quit if no PC assignments
  Q:'$D(@SC1)
  S SCADT=0
  F  S SCADT=$O(@SC1@(SCADT)) Q:SCADT=""  D
- .S SCTP=0
- .F  S SCTP=$O(@SC1@(SCADT,SCTP)) Q:'SCTP  D
- ..; quit if team position does not exist
- ..Q:'$D(^SCTM(404.57,SCTP,0))
- ..S SCPAI=0
- ..F  S SCPAI=$O(@SC1@(SCADT,SCTP,SCPAI)) Q:'SCPAI  D
- ...S SCDDT=$P($G(^SCPT(404.43,SCPAI,0)),U,4)
- ...;quit if not active within date range
- ...Q:$$DTCHK^SCAPU1(SC177,DT,0,SCADT,SCDDT)<1
- ...N SCVAR S SCVAR=SCPAI_";SCPT(404.43,"
- ...;add to HL7 event file
- ...Q:$D(^SCPT(404.48,"AACXMIT",SCVAR))
- ...Q:$$CHECK^SCMCHLB1(SCVAR)'=1
- ...D ADD^SCMCHLE("NOW",SCVAR,SCDFN,SCTP)
+ . S SCTP=0
+ . F  S SCTP=$O(@SC1@(SCADT,SCTP)) Q:'SCTP  D
+ . . ;
+ . . ; quit if team position does not exist
+ . . Q:'$D(^SCTM(404.57,SCTP,0))
+ . . S SCPAI=0
+ . . F  S SCPAI=$O(@SC1@(SCADT,SCTP,SCPAI)) Q:'SCPAI  D
+ . . . S SCDDT=$P($G(^SCPT(404.43,SCPAI,0)),U,4)
+ . . . ;
+ . . . ; quit if not active within date range
+ . . . Q:$$DTCHK^SCAPU1(SC177,DT,0,SCADT,SCDDT)<1
+ . . . N SCVAR S SCVAR=SCPAI_";SCPT(404.43,"
+ . . . ;
+ . . . ; add to HL7 event file
+ . . . Q:$D(^SCPT(404.48,"AACXMIT",SCVAR))
+ . . . Q:$$CHECK^SCMCHLB1(SCVAR)'=1
+ . . . D ADD^SCMCHLE("NOW",SCVAR,SCDFN,SCTP)
  Q
 PRSEED ;seed practitioner
@@ -214,6 +204,7 @@
  S SC177=$$PDAT^SCMCGU("SD*5.3*177")
  I +SC177=0 D  Q
- . S SC2=" No SD*5.3*177 Installation Date."
+ . S SC2="  Unable to obtain SD*5.3*177 Installation Date."
  . D MSG^SCMCCV6(SC1,SC2)
+ . Q
  S DIC=200,DIC(0)="MEQA",DIC("A")="Select Provider: " D ^DIC Q:Y'>0
  S SCPROV=+Y
@@ -230,5 +221,5 @@
  . D ADD^SCMCHLE("NOW",SCVAR,,AH,1)
  Q
-INCON ;inconsistent PC assignments
+INCON ;get list of incositent provider assignments
  N POS
  D INCON^SCMCTSK3
@@ -240,4 +231,11 @@
  D EN1^DIP
  Q
+CHKENR(DATA,INFO) ;check if patient enrolled in teamposition clinic
+ S DATA(0)=-1
+ N I
+ N POS,DFN S DFN=+$G(INFO) Q:'DFN  S POS=+$P($G(INFO),U,2) Q:'POS
+ F I=0:0 S I=$O(^SCTM(404.57,POS,5,I)) Q:'I  D CECHK^SCRPPAT2(I,.CNAME,DFN) I $L(CNAME) S:DATA(0)=-1 DATA(0)="" S DATA(0)=DATA(0)_CNAME_"."
+ I DATA(0)'=-1 S DATA(0)=$E(DATA(0),1,$L(DATA(0))-2)
+ Q
 INACTDT(PA) ;Scheduled inactivation date.
  D INACT^SCMCTSK3 Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCTSK2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK2.m	(revision 636)
@@ -1,91 +1,85 @@
-SCMCTSK2 ;ALB/JDS - PCMM Inactivation Nightly Job; 18 Apr 2003  9:36 AM ; 10/24/07 12:23pm  ; Compiled November 21, 2007 13:32:47  ; Compiled March 17, 2008 15:27:15
- ;;5.3;Scheduling;**297,498,527,499**;AUG 13, 1993;Build 21
- Q
-NIGHT ;
- N ENDDT,NOINAC,SIXM,FLGDT,L,PATDT,SEEN,SDDT
- D DT^DICRW S SDDT=$P($G(^XTMP("SCMCTSK2-"_DT,0)),U,2)
- I SDDT="" S SDDT=DT
- S ALPHA=$G(^SCTM(404.44,1,1)),ALPHA=$P(ALPHA,U,8) I ALPHA<SDDT S ALPHA=0
- ;if 'ALPHA NOINAC=1 except 15th and the Last Day of a Month (LDoM)
- ;inact only on 15th and on LDoM
- S NOINAC=0
- I 'ALPHA  S X1=SDDT,X2=1 D C^%DTC I ($E(SDDT,6,7)'=15)&($E(SDDT,1,5)=$E(X,1,5)) S NOINAC=1
- I 'ALPHA D INACTIVE^SCMCTSK1
+SCMCTSK2 ;ALB/JDS - PCMM Inactivation Nightly Job; 18 Apr 2003  9:36 AM ; 10/24/07 12:23pm
+ ;;5.3;Scheduling;**297,498,527**;AUG 13, 1993;Build 6
+ Q
+NIGHT ;nightly task for inact.
+ N ENDDT,NOINAC,SIXM,FLGDT,L,PATDT,SEEN
+ K ^TMP("SCTSK",$J)
+ D DT^DICRW
+ S ALPHA=$G(^SCTM(404.44,1,1)),ALPHA=$P(ALPHA,U,8) I ALPHA<DT S ALPHA=0
+ ;check if this is last day of month
+ S X1=DT,X2=1 D C^%DTC I $E(DT,1,5)'=$E(X,1,5) I 'ALPHA D INACTIVE^SCMCTSK1
  S SIXM=$P($G(^SCTM(404.44,1,1)),U,9)
  I SIXM D PRFLAG
  I ALPHA D INACTIVE^SCMCTSK1
- ;determine ENDDT-Inactn Date-30 days if flagged today
- F DATE=0:0 S DATE=$O(^SCPT(404.43,"AFLG",DATE)) Q:'DATE  D
+ S NOINAC=0 I 'ALPHA  S X1=DT,X2=1 D C^%DTC I ($E(DT,6,7)'=15)&($E(DT,1,5)=$E(X,1,5)) S NOINAC=1
+ ;check for 60 days after flagged for inact.
+ S X1=DT,X2=$S(ALPHA:-2,1:-30) D C^%DTC S ENDDT=X
+ F DATE=0:0 S DATE=$O(^SCPT(404.43,"AFLG",DATE)) Q:(('DATE)!(('NOINAC)&(DATE>ENDDT)))  D
  .F ENTRY=0:0 S ENTRY=$O(^SCPT(404.43,"AFLG",DATE,ENTRY)) Q:'ENTRY  D
  ..S ZERO=$G(^SCPT(404.43,ENTRY,0)) Q:'ZERO
  ..S DFN=+$G(^SCPT(404.42,+ZERO,0)) Q:'DFN
  ..S POS=$P(ZERO,U,2)
- ..I $P(ZERO,U,4) D UNFLG Q  ;unass.
- ..S X1=DATE,X2=$S(ALPHA:+2,1:+30) D C^%DTC S ENDDT=X
- ..N SDASS S SDASS=$P(ZERO,U,3)
- ..;N-new or E-stbl.
- ..;assig >12 months since flagging, not NEW, E-stbl)
- ..N NEW
- ..S NEW=0 S X1=DATE,X2=SDASS D ^%DTC I X<365 S NEW=1
- ..I NEW S %DT="",X="T-12M" D ^%DT S STDT=+Y D
- ...S X1=STDT,X2=-7 D C^%DTC S TYDT=X
- ..I 'NEW S %DT="",X="T-24M" D ^%DT S STDT=+Y D
- ...S X1=STDT,X2=-7 D C^%DTC S TYDT=X
- ..;
- ..I $P(ZERO,U,17) D UNFLG Q  ;react.
- ..;get prec 
- ..;S %DT="",X="T-12M" D ^%DT S STDT=+Y
- ..;S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS)
- ..I '$P(ZERO,U,5) D UNFLG Q  ;Not PC
- ..D SEEN^SCMCTSK1(DFN,POS,TYDT,SDDT,.PROV,.PRECP,.SEEN)
- ..;S PC=$$GET^XUA4A72(+PROV)
- ..I SEEN D UNFLG Q
- ..I $P(ZERO,U,13) S X1=DATE,X2=$S(ALPHA:4,1:90) D C^%DTC S FLGDT=X I FLGDT>SDDT Q  ;do not inactivate yet; extended
- ..I ('NOINAC)&(SDDT'<ENDDT) D DIS^SCMCTSK1
- ;flag prov 6m after install sd/297
- I NOINAC D:ALPHA BULL I '$D(^SCPT(404.43,"AFLG",SDDT)) K ^TMP($J,"SCMCTSK2") Q
- ;flag prov 6m after install sd/297
- I SIXM,SIXM'>SDDT D
+ ..I $P(ZERO,U,4) D UNFLG Q  ;already unassigned
+ ..I $P(ZERO,U,13) S X1=DATE,X2=$S(ALPHA:4,1:90) D C^%DTC S FLGDT=X I FLGDT>DT Q    ;ext
+ ..;check if criteria still met
+ ..I $P(ZERO,U,17) D UNFLG Q  ;Already reactivated
+ ..;get preceptor position
+ ..S %DT="",X="T-12M" D ^%DT S STDT=+Y
+ ..S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS)
+ ..;see if provider changed
+ ..I $O(^SCTM(404.52,"AIDT",+PREC,1,-STDT),-1) D UNFLG Q
+ ..I '$P(ZERO,U,5) D UNFLG Q  ;Not primary care
+ ..S PROV=+$$GETPRTP^SCAPMCU2(POS,DT)
+ ..S PC=$$GET^XUA4A72(+PROV)
+ ..S SC297=$$PDAT^SCMCGU("SD*5.3*297")
+ ..N NEW S NEW=$S($P(ZERO,U,3)<SC297:0,1:1)   ;D D^%DTC S NEW=$S(X>330:0,1:1)
+ ..S X1=DT,X2=SC297 D D^%DTC S SC297=X
+ ..S X="T-"_$S(SC297>365:"11M",NEW:"11M",1:"23M") D ^%DT S TYDT=+Y D SEEN^SCMCTSK1 I $G(SEEN) D UNFLG Q 
+ ..S X="T-"_$S(SC297>365:"12M",NEW:"12M",1:"24M") D ^%DT S TYDT=+Y D SEEN^SCMCTSK1 I $G(SEEN) D:(DATE>ENDDT) UNFLG Q
+ ..I ('NOINAC)&(DATE'>ENDDT) D DIS^SCMCTSK1
+ ..;D MSG(POS,DFN)
+ ;if 6 months after installation check to flag providers
+ I NOINAC D:ALPHA BULL Q
+ S PATDT=$$PDAT^SCMCGU("SD*5.3*297") Q:'PATDT
+ I SIXM,SIXM'>DT D
  .D PRINAC
  .N FLDA
  .S FLDA(404.44,"1,",19)=""
  .D FILE^DIE("I","FLDA","ERR")
- D BULL K ^TMP($J,"SCMCTSK2")
- Q
-UNFLG ;Unflagging
+ D BULL
+ Q
+UNFLG ;Remove the flag
  N DR,DIE,DA
  S DR=".15///@;.13///@;.12///@",DIE="^SCPT(404.43,",DA=ENTRY D ^DIE
  Q
-PRFLAG ;flag incorrect provider pos
+PRFLAG ;flag incorrect provider positions
  N POS
- ;prov inact. has run once
+ ;provider inactivation has run once
  I $P($G(^SCTM(404.44,1,1)),U,11)'="" Q
  D PRFLAG^SCMCTSK3
  Q
-PRINAC ;inact. flagged providers
+PRINAC ;inactivate flagged providers
  N I,II
- ;Prov inact. run already
- I $G(SDDT)="" S SDDT=DT
- S II=$P($G(^SCTM(404.44,1,1)),U,11) I II'="",II'=SDDT Q
+ ;Provider inactivation run already
+ S II=$P($G(^SCTM(404.44,1,1)),U,11) I II'="",II'=DT Q
  F I=0:0 S I=$O(^SCTM(404.52,I)) Q:'I  S ZERO=$G(^(I,0)) I $P(ZERO,U,10) D
  .;I $P(ZERO,U,10)>$G(ENDT) Q   ;not time yet
- .I $O(^SCTM(404.52,"AIDT",+ZERO,0,-9999999))<(-$P(ZERO,U,2)) Q   ;inactivated
- .;Check valid criteria
+ .I $O(^SCTM(404.52,"AIDT",+ZERO,0,-9999999))<(-$P(ZERO,U,2)) Q   ;already inactivated
+ .;Check if criteria still valid
  .S POS=+ZERO
- .S PROV=+$$GETPRTP^SCAPMCU2(POS,SDDT)
+ .S PROV=+$$GETPRTP^SCAPMCU2(POS,DT)
  .S PC=$$GET^XUA4A72(+PROV)
  .S DR=".091///@",DIE="^SCTM(404.52,",DA=I D ^DIE  ;remove flag
  .S ZERO1=$G(^SCTM(404.57,POS,0))
  .I '$D(^SD(403.46,+$P(ZERO1,U,3),2,+PC)) D
- ..;inactivation
- ..S DIC="^SCTM(404.52,",X=+ZERO,DIC("DR")=".02////"_SDDT_";.03////"_$P(ZERO,U,3)_";.04////0;.05///EMPLOYEE LEAVES POSITION;.11////1"
+ ..;enter the inactivation
+ ..S DIC="^SCTM(404.52,",X=+ZERO,DIC("DR")=".02////"_DT_";.03////"_$P(ZERO,U,3)_";.04////0;.05///EMPLOYEE LEAVES POSITION;.11////1"
  ..S DIC(0)="LM" D ^DIC
- ;only run inact. once
- S $P(^SCTM(404.44,1,1),U,11)=SDDT
- Q
-FUTAPP(DFN) ;print future appts
+ ;only run the inactivation once.
+ S $P(^SCTM(404.44,1,1),U,11)=DT
+ Q
+FUTAPP(DFN) ;print future appointments
  N TAB,SCDT0 S TAB=$X
- I $G(SDDT)="" S SDDT=DT
- S SCDT=SDDT+.24
+ S SCDT=DT+.24
  F  S SCDT=$O(^DPT(DFN,"S",SCDT)) Q:'SCDT  D
  . S SCDT0=$G(^DPT(DFN,"S",SCDT,0)) Q:$L($P(SCDT0,U,2))
@@ -93,29 +87,28 @@
  . S Y=SCDT X ^DD("DD") W $E(Y_" ",1,17)_" "_$E($P($G(^SC(+CLIEN,0)),U),1,10)
  Q
-GETASC(DATA,ENTRY) ;get assoc. clinics
+GETASC(DATA,ENTRY) ;get associated clinics
  N I,CNT S CNT=0
  F I=0:0 S I=$O(^SCTM(404.57,+$G(ENTRY),5,I)) Q:'I  S CNT=CNT+1,DATA(CNT)=I_U_$P($G(^SC(I,0)),U)
  Q
-SETASC(RESULT,DATA) ;set assoc. clinics
+SETASC(RESULT,DATA) ;set associated clinics
  D SETASC^SCMCTSK7(.RESULT,DATA) Q
-MSG(SCTP,DFN) ;send inact. message
- ;given valid positions get current practitioners
+MSG(SCTP,DFN) ;send inactivation message
+         ;given list of valid positions get current practitioners
  S SCLIST="SCL"
- I $G(SDDT)="" S SDDT=DT
  I "N"'[$P($G(^SCTM(404.57,SCTP,2)),U,9) D
  .S SCOK=$$PRTP^SCAPMC(SCTP,"",.SCLIST,.SCERR)
  .;if preceptor notice turned on for message type
  I +$P($G(^SCTM(404.57,SCTP,2)),U,9) D
- .S SCX=+$$OKPREC2^SCMCLK(SCTP,SDDT)
+ .S SCX=+$$OKPREC2^SCMCLK(SCTP,DT)
  .;if preceptor duz returned, add to array
  .I SCX S @SCLIST@("SCPR",SCX)=""
  N XMY F I=0:0 S I=$O(@SCLIST@("SCPR",I)) Q:'I  S XMY(I)=""
- S SCTEXT(1,0)="PATIENT "_$P($G(^DPT(DFN,0)),U)_" has been inactivated from PC team position "_$P($G(^SCTM(404.57,SCTP,0)),U)
+ S SCTEXT(1,0)="PATIENT "_$P($G(^DPT(DFN,0)),U)_" has been inactivated from primary care team position "_$P($G(^SCTM(404.57,SCTP,0)),U)
  S XMSUB="Provider's Inactivated Primary Care Patients" D ^XMD
  Q
-BULL ;EOM Bulletin
+BULL ;end of Month Bulletin
  N DISUPNO,BY,DHIT,HEAD
  S DISUPNO=1,L=0
- S XMSUB="Patients Scheduled for Inactivation from PC Panel"
+ S XMSUB="Patients Scheduled for Inactivation from Primary Care Panel"
  S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
  K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J),^TMP("SCML",$J)
@@ -130,9 +123,9 @@
  .K XMY S XMY(SCI)="" K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J)
  .M ^TMP("SCMC",$J)=^TMP("SCF",$J,SCI)
- .S XMSUB="Patients Scheduled for Inactivation from PC Panel"
+ .S XMSUB="Patients Scheduled for Inactivation from Primary Care Panel"
  .S XMTEXT="^TMP(""SCMCTXT"",$J,"
+ .;D LINES(1) D ^XMD
  S DISUPNO=1
  K ^TMP("SCMC",$J),^TMP("SCMCTXT")
- I $G(NOINAC) K ^TMP($J,"SCMCTSK2") Q  ; SD/499
  S XMSUB="Patients With Extended PCMM Inactivation Dates"
  S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
@@ -147,5 +140,5 @@
  S DISUPNO=1
  K ^TMP("SCMC",$J),^TMP("SCMCTXT")
- S XMSUB="Patients Automated Inactivations from PC Panels"
+ S XMSUB="Patients Automated Inactivations from Primary Care Panels"
  S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
  K ^TMP("SCMC",$J)
@@ -160,5 +153,5 @@
  K ^TMP("SCMC",$J),^TMP("SCMCTXT")
  I $P($G(^SCTM(404.44,1,1)),U,11)="" D
- . S XMSUB="PC Providers Scheduled for Inactivation"
+ . S XMSUB="Primary Care Providers Scheduled for Inactivation"
  . S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
  . K ^TMP("SCMC",$J)
@@ -189,5 +182,5 @@
 INRPT  ; REPORT
  N DIOEND,SCDHD
- D PROMPT^SCMCTSK3("** Date Range Selection **","DATE PATIENTS INACTIVATED FROM PC PANELS")
+ D PROMPT^SCMCTSK3("**** Date Range Selection ****","DATE PATIENTS INACTIVATED FROM PRIMARY CARE PANELS")
  Q:'$D(^TMP("SC",$J,"XR"))
  D UNASSIGN^SCMCTSK3
@@ -201,6 +194,6 @@
  D EN1^DIP
  Q
-IN30 ;inact. last month
- N DIPA,SDD D SORT^SCMCTSK1(.DIPA,.SDD) Q:'SDD  ;SD/499
+IN30 ;inactivated last month
+ D SORT^SCMCTSK1 Q:'X
  S Q=""""
  S DIC="^SCPT(404.43,",L=0,BY="[SCMC INACTIVATION SORT]"
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK3.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCTSK3.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK3.m	(revision 636)
@@ -1,4 +1,4 @@
-SCMCTSK3 ;ALB/JDS - PCMM Inactivation Reports ; 7/19/05 10:06am  ; Compiled June 7, 2007 13:57:55  ; Compiled February 12, 2008 11:46:47
- ;;5.3;Scheduling;**297,499**;AUG 13, 1993;Build 21
+SCMCTSK3 ;ALB/JDS - PCMM Inactivation Reports ; 7/19/05 10:06am
+ ;;5.3;Scheduling;**297**;AUG 13, 1993
  Q
 SORTP  ;sort template
@@ -78,5 +78,5 @@
  .D SUBT^SCRPW50(DATESORT)
  .S SCBDT("B")="T-30",SCEDT("B")="TODAY"
- .I (DATESORT["Scheduled Ina")!(DATESORT["Scheduled for Inactivation") S SCEDT("B")="T+60"
+ .I (DATESORT["Scheduled Ina")!(DATESORT["Scheduled for Inactivation") S SCEDT("B")="T+30"
  S LIST="DIV,TEAM,POS,ASPR"
  ;D SUBT^SCRPW50("**** Date Range Selection ****")
@@ -210,12 +210,7 @@
  .I '$D(^SD(403.46,+$P(ZERO,U,3),2,+PC)) S ^TMP("SCMCTSK",$J,POSH)="Person Class is not valid for this role"
  F POS=0:0 S POS=$O(^TMP("SCMCTSK",$J,POS)) Q:'POS  S FLDA(404.52,POS_",",.091)=DT
-VERPR ;verify already flagged positions; SD/499 replaced "AFLG" with "AFLAG"
- N II,POSH S II="" F  S II=$O(^SCTM(404.52,"AFLAG",II)) Q:'II  S POSH=""  F  S POSH=$O(^SCTM(404.52,"AFLAG",II,POSH)) Q:'POSH  D
- .N ZERO,ZEROTP S ZERO=$G(^SCTM(404.52,POSH,0))
+ F I=0:0 S I=$O(^SCTM(404.52,"AFLG",I)) Q:'I  F POSH=0:0 S POSH=$O(^SCTM(404.52,"AFLG",I,POSH)) Q:'POSH  D
+ .N ZERO S ZERO=$G(^SCTM(404.52,POSH,0))
  .I '$P(ZERO,U,4) S FLDA(404.52,POSH_",",.091)="" Q
- .;SD/499; added verification of the POSSIBLE PRIMARY PRACTITIONER field
- .;in the TEAM POSITION file
- .N TP S TP=$P(ZERO,U) S ZEROTP=$G(^SCTM(404.57,TP,0))
- .I '$P(ZEROTP,U,4) S FLDA(404.52,POSH_",",.091)="" Q
  .I (-$O(^SCTM(404.52,"AIDT",+ZERO,0,-9999999)))>$P(ZERO,U,2) S FLDA(404.52,POSH_",",.091)=""
  I $O(FLDA(0)) D FILE^DIE("I","FLDA","ERR")
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK4.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCTSK4.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK4.m	(revision 636)
@@ -1,4 +1,4 @@
 SCMCTSK4 ;ALB/JDS - PCMM Inactivation Reports ; 18 Apr 2003  9:36 AM
- ;;5.3;Scheduling;**297,526**;AUG 13, 1993;Build 8
+ ;;5.3;Scheduling;**297**;AUG 13, 1993
  Q
 POSCHK ;
@@ -30,5 +30,5 @@
  W !,"   Field Name              Explanation of field name"
  W !,"   Patient Name            Name of patient scheduled to be inactivated from their primary care team and position/provider"
- W !,"   SSN                     Patient SSN."
+ W !,"   SSN                     Patient's last 4 Social Security numbers."
  W !,"   PC Team                 Patient's assigned Primary Care team in PCMM."
  W !,"   Provider                Name of primary care practitioner/provider currently assigned to the patient.  This will be an"
@@ -56,5 +56,5 @@
  W !,"  Field Name              Explanation of field name"
  W !,"  Patient Name            Name of patient scheduled to be inactivated from their primary care team and position/provider."
- W !,"  SSN                     Patient SSN."
+ W !,"  SSN                     Patient's last 4 SSN numbers."
  W !,"  Institution             Institution name, previously called Division, in which patient receives primary care."
  W !,"  PC Team                 Patient's assigned Primary Care team in PCMM."
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK9.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCTSK9.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTSK9.m	(revision 636)
@@ -1,4 +1,4 @@
 SCMCTSK9 ;;BP/DMR - PCMM ; 18 Apr 2003  9:36 AM
- ;;5.3;Scheduling;**297,526**;AUG 13, 1993;Build 8
+ ;;5.3;Scheduling;**297**;AUG 13, 1993
  Q
 EXTKEY ;
@@ -10,5 +10,5 @@
  W !
  W !,"Patient Name          Name of patient scheduled to be inactivated from their primary care team and position/provider."
- W !,"SSN                   SSN number."
+ W !,"SSN                   Patient's last 4 SSN numbers."
  W !,"Institution           Institution name, previously called Division, in which patient receives primary care."
  W !,"PC Team               The patient's assigned Primary Care team in PCMM."
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCYPC.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCYPC.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCYPC.m	(revision 636)
@@ -1,3 +1,3 @@
-SCMCYPC ; GENERATED FROM 'SCMC DIRECT PC FTEE' PRINT TEMPLATE (#1320) ; 12/27/06 ; (FILE 404.52, MARGIN=132)
+SCMCYPC ; GENERATED FROM 'SCMC DIRECT PC FTEE' PRINT TEMPLATE (#1320) ; 12/25/06 ; (FILE 404.52, MARGIN=132)
  G BEGIN
 CP G CP^DIO2
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMSVUT2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMSVUT2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMSVUT2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCMSVUT2 ;ALB/JLU;Utility routine for AMBCARE;06/28/99
- ;;5.3;Scheduling;**66,180,254,293,325,466,521**;AUG 13,1993;Build 1
+ ;;5.3;Scheduling;**66,180,254,293,325,466**;AUG 13,1993;Build 2
  ;06/28/99 ACS Added CPT modifier validation
  ;
@@ -195,8 +195,8 @@
  I STDT="" Q 0
  S STDT=$$FMDATE^HLFNC(STDT)
- S X=STDT,%DT="X" D ^%DT I Y=-1 Q 0  ;SD/521 added %DT
+ S X=STDT D ^%DT I Y=-1 Q 0
  I ENDT="" Q 1
  S ENDT=$$FMDATE^HLFNC(ENDT)
- S X=ENDT,%DT="X" D ^%DT I Y=-1 Q 0  ;SD/521 added %DT
+ S X=ENDT D ^%DT I Y=-1 Q 0
  I $$FMDIFF^XLFDT(ENDT,STDT,1)<0 Q 0
  Q 1
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPBK11.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPBK11.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPBK11.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPBK11 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
- ;;5.3;Scheduling;**41,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41**;AUG 13, 1993
  ;
 GETSEL(SCDATA,SCTYPE,SCIEN) ; 
@@ -83,7 +83,7 @@
  D SET("    Division: "_$S($G(SC(SCFLE,SCIEN,3.5))]"":SC(SCFLE,SCIEN,3.5),1:SCDEF),.SCINC,.SCDATA)
  D SET(" ",.SCINC,.SCDATA)
- D SET("Associated Teams and Positions:",.SCINC,.SCDATA)
+ D SET("Assoicated Teams and Positions:",.SCINC,.SCDATA)
  D SET("-------------------------------",.SCINC,.SCDATA)
- S SCI=0 F  S SCI=$O(^SCTM(404.57,"E",SCID,SCI)) Q:'SCI  D
+ S SCI=0 F  S SCI=$O(^SCTM(404.57,"D",SCID,SCI)) Q:'SCI  D
  . S X=$G(^SCTM(404.57,SCI,0))
  . D SET("      Team: "_$P($G(^SCTM(404.51,+$P(X,U,2),0)),U),.SCINC,.SCDATA)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPEC.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPEC.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPEC.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPEC ;ALB/CMM - Detail List of Pts & Enroll Clinics ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,140,174,177,431,526,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,140,174,177,431**;AUG 13, 1993
  ;
  ;Detailed Listing of Patients and Their Enrolled Clinics Report
@@ -80,8 +80,8 @@
  Q
  ;
-PDATA(DFN,CLNEN,CNAME,FLAG) ;
+PDATA(DFN,CLNEN,FLAG) ;
  ;Collect and format data for report
  ;
- N NODE,NAME,PID,PELIG,MT,PSTAT,STATD,DATA,LAST,NEXT
+ N NODE,NAME,PID,PELIG,MT,PSTAT,STATD,DATA,LAST,NEXT,CEN,CNAME
  S DATA=""
  S NODE=$G(^DPT(DFN,0))
@@ -90,11 +90,15 @@
  S MT=$$LST^DGMTU(DFN),MT=$P(MT,"^",4)  ;means test status SD*5.3*431
  S PELIG=$$ELIG^SCRPU3(DFN) ;primary eligibility
- S PSTAT="N/A"
- S STATD=""
- S LAST=$$GETLAST^SCRPU3(DFN,.CLNEN) ;last Clinic appointment
- S NEXT=$$GETNEXT^SCRPU3(DFN,.CLNEN) ;next clinic appointment
- ;I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(PTIEN,INS,TIEN,PDATA,CNAME,CIEN)
- I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(NAME,PID,MT,PELIG,PSTAT,STATD,LAST,NEXT,CNAME),DATA=$E(NAME,1,12)_"^"_DATA
- I $D(FLAG) S DATA=$E(NAME,1,12)_"^"_PID_"^"_MT_"^"_PELIG_"^"_PSTAT_"^"_STATD_"^"_LAST_"^"_NEXT
+ ;
+ S CNAME=$P($G(^SC(CLNEN,0)),"^")
+ S CEN=+$O(^DPT(DFN,"DE","B",CLNEN,""))
+ S NODE=$G(^DPT(DFN,"DE",CEN,1,1,0))
+ S PSTAT=$P(NODE,"^",2) S PSTAT=PSTAT_$S(PSTAT="A":"C",PSTAT="O":"PT",1:"") ;opt or ac status
+ I $P(NODE,"^")="" S STATD=""
+ I $P(NODE,"^")'="" S STATD=$TR($$FMTE^XLFDT($P(NODE,"^"),"5DF")," ","0") ;enrollment date
+ S LAST=$$GETLAST^SCRPU3(DFN,CLNEN) ;last clinic appointment
+ S NEXT=$$GETNEXT^SCRPU3(DFN,CLNEN) ;next clinic appointment
+ I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(NAME,PID,MT,PELIG,PSTAT,STATD,LAST,NEXT,CNAME),DATA=$E(NAME,1,20)_"^"_DATA
+ I $D(FLAG) S DATA=$E(NAME,1,20)_"^"_PID_"^"_MT_"^"_PELIG_"^"_PSTAT_"^"_STATD_"^"_LAST_"^"_NEXT
  Q DATA
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPEC2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPEC2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPEC2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPEC2 ;ALB/CMM - Detail List of Pts & Enroll Clinics Continued ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,140,174,177,526**;AUG 13, 1993;Build 8
+ ;;5.3;Scheduling;**41,140,174,177**;AUG 13, 1993
  ;
  ;Detailed Listing of Patients and Their Enrolled Clinics Report
@@ -106,5 +106,5 @@
  S HLD="H1"
  S @STORE@("SUBHEADER",HLD)="Patient Name"
- S $E(@STORE@("SUBHEADER",HLD),16)="Pt ID"
+ S $E(@STORE@("SUBHEADER",HLD),18)="Pt ID"
  S $E(@STORE@("SUBHEADER",HLD),25)="Stat"
  S $E(@STORE@("SUBHEADER",HLD),31)="Elig"
@@ -129,7 +129,7 @@
  ;CIEN - clinic ien
  ;
- S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,12) ;patient name
- S $E(@STORE@(INS,TIEN,CIEN,PTIEN),14)=$P(PDATA,"^",2) ;primary long id 9 digit
- S $E(@STORE@(INS,TIEN,CIEN,PTIEN),26)=$P(PDATA,"^",3) ;means test category
+ S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,15) ;patient name
+ S $E(@STORE@(INS,TIEN,CIEN,PTIEN),18)=$E($P(PDATA,"^",2),6,10) ;primary long id last 4 plus P
+ S $E(@STORE@(INS,TIEN,CIEN,PTIEN),25)=$P(PDATA,"^",3) ;means test category
  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",4) ;primary eligibility
  ;Removed by patch 174
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPITP.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPITP.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPITP.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPITP ;ALB/CMM - Individual Team Profile ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,52,177,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,52,177**;AUG 13, 1993
  ;
  ;Individual Team Profile
@@ -105,5 +105,5 @@
  ;
 PRINTIT(STORE,TITL) ;
- N INST,EINST,ETEAM,TEM,NEW,PAGE,TNAME,TIEN,EN,SUB,POS,CIEN,INF,ACL
+ N INST,EINST,ETEAM,TEM,NEW,PAGE,TNAME,TIEN,EN,SUB,POS,CIEN,INF
  S (INST,EINST)="",STOP=0,(PAGE,NEW)=1 W:$E(IOST)="C" @IOF
  D FORHEAD^SCRPITP2
@@ -136,14 +136,9 @@
  ..I $Y<IOSL-10 D COLUMN^SCRPITP2
  ..F  S POS=$O(@STORE@(INST,TIEN,"P",POS)) Q:POS=""!(STOP)  D
+ ...I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132) Q:STOP  D CONT^SCRPITP2
+ ...I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132) Q:STOP  D CONT^SCRPITP2
+ ...I STOP Q
  ...W !,$G(@STORE@(INST,TIEN,"P",POS))
- ...S ACL=""
- ...F  S ACL=$O(@STORE@(INST,TIEN,"P",POS,ACL)) Q:ACL=""!(STOP)  D
- ....W !,$G(@STORE@(INST,TIEN,"P",POS,ACL))
- ....I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132) Q:STOP  D CONT^SCRPITP2
- ....I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132) Q:STOP  D CONT^SCRPITP2
- ....I STOP Q
- ...;W !,$G(@STORE@(INST,TIEN,"P",POS))
- ...;W !,$G(@STORE@(INST,TIEN,"P",POS,ACL))
- ...W !
+ ..W !
  I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
  Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPITP2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPITP2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPITP2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPITP2 ;ALB/CMM - Individual Team Profile Continued ;7/25/99  18:24
- ;;5.3;Scheduling;**41,177,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,177**;AUG 13, 1993
  ;
  ;Individual Team Profile
@@ -16,5 +16,5 @@
  S POS=$P(TNODE,"^") ;position name
  S ROL=$P($G(^SD(403.46,+$P(TNODE,"^",3),0)),"^") ;standard position
- S PPC=$S($P(TNODE,"^",4)'=1:"NPC",+$$OKPREC3^SCMCLK(TPOS,DT)>0:" AP",1:"PCP") ;primary care position
+ S PPC=$S($P(TNODE,"^",4)'=1:"NPC",+$$OKPREC3^SCMCLK(TPOS,DT)>1:" AP",1:"PCP") ;primary care position
  S MAX=$P(TNODE,"^",8)
  ;
@@ -24,17 +24,10 @@
  S SCPTASS=$$PCPOSCNT^SCAPMCU1(TPOS,DT,0)
  ;
- ;D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,SCPROV,SCPTASS)
+ S CIEN=+$P(TNODE,"^",9) ;clinic ien
+ S PCLIN=""
+ I CIEN>0 S PCLIN=$P($G(^SC(CIEN,0)),"^") ;associated clinic
  ;
- D SETASCL^SCRPRAC2(TPOS,.CNAME,.CLIEN)
- S CNAME=$G(CNAME(0))
- ;S CIEN=+$P(TNODE,"^",9) ;clinic ien ;USING MULTIPLE WITH SD*5.3*520
- ;S PCLIN=""
- ;I CIEN>0 S PCLIN=$P($G(^SC(CIEN,0)),"^") ;associated clinic
+ D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,PCLIN,SCPROV,SCPTASS)
  ;
- D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,CNAME,SCPROV,SCPTASS)
- N AC
- S AC=0
- F  S AC=$O(CNAME(AC)) Q:AC=""  D FORMATAC(POS,DIV,TM,TPOS,CNAME(AC))
- K CNAME
  Q
  ;
@@ -101,9 +94,5 @@
  S $E(@STORE@(DIV,TM,"P",POS),82)=$J(MAX,6,0) ;number of patients allowed
  S $E(@STORE@(DIV,TM,"P",POS),92)=$J(SCPTASS,6,0) ;patients assigned
- S $E(@STORE@(DIV,TM,"P",POS),103)=$E(CNAME,1,30)
- Q
- ;
-FORMATAC(POS,DIV,TM,TPOS,CNAME) ;clinic name
- S $E(@STORE@(DIV,TM,"P",POS,AC),103)=$E(CNAME,1,30)
+ S $E(@STORE@(DIV,TM,"P",POS),103)=$E(CNAME,1,30) ;clinic name
  Q
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPPAT2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPPAT2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPPAT2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
- ;;5.3;Scheduling;**41,48,174,181,177,231,433,297,526,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,48,174,181,177,231,433,297**;AUG 13, 1993
  ;
  ;Listing of Practitioner's Patients
@@ -26,6 +26,6 @@
  ;ARY - array of patients for selected practitioner
  ;PRAC - practitioner ien
- N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
- N PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
+ N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,CNAME,PTA,PTAN,TIEN
+ N PC,TNODE,TNAME,PINF,POSN,PRCP
  S NXT=0
  F  S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N)  D
@@ -49,31 +49,18 @@
  .I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q  ;not a selected role
  .S POSN=$P(TPN,"^") ;position name
- .D SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN)  ;get clinics from multiple
- .;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
+ .S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
  .;commented next line off - clinic enrollment no longer needed SD*5.3*433
  .;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
- .;S CNAME=$P($G(^SC(CLIEN,0)),"^")  ; SD*5.3*433 remove enroll check
+ .S CNAME=$P($G(^SC(CLIEN,0)),"^")  ; SD*5.3*433 remove enroll check
  .S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no
  .S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;practitioner name
  .Q:PNAME=""
  .S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2)
- .D GETPINF(PIEN,.CLIEN,.PINF)  ;get patient information and appointments
- .S CNAME=$G(CNAME(0))  ;first line will capture position information
- .S PINF=$G(PINF(0))
- .I PINF=""  D 
- ..S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
- .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
- .D SETFORM(PIEN,.CNAME,.PINF)
-SETFORM(PIEN,CNAME,PINF)  ;Format for clinic info only for multiples
- N SCCNT
- S SCCNT=0 F  S SCCNT=$O(PINF(SCCNT)) Q:SCCNT=""  D FORMATAC(CNAME(SCCNT),PINF(SCCNT),PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
- Q
-GETPINF(PIEN,CLIEN,PINF)  ;get patient info 
- N SCCNT
- S SCCNT="" F  S SCCNT=$O(CLIEN(SCCNT)) Q:SCCNT=""  D 
- .S PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
+ .S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN,1)
+ .;$$PDATA returns pt name,pid,mt,pelig,status,status date,last appt,nxt appt
+ .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ;formats data for display
  Q
  ;
-CECHK(CLIEN,CNAME,PIEN) ;should no longer be used as of patch SD*5.3*433
+CECHK(CLIEN,CNAME,PIEN) ;
  ;CLIEN - clinic ien
  ;CNAME - clinic name returned if patient is enrolled in clien clinic
@@ -112,26 +99,5 @@
  Q
  ;
-FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
- ;CNAME - clinic name
- ;PINF - patient/clinic data
- ;PC - primary care 1/0
- ;TIEN - team file ien (#404.51)
- ;TNAME - team name
- ;PRAC - practitioner ien (#200)
- ;PNAME - practitioner name
- ;POSN - position name
- ;TPI - team position ien (#404.57)
- ;PRCP - preceptor name
- ;
- N IIEN,INAME,ERR
- S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
- I ERR Q
- ;
- I SORT=1 D STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,team,practitioner
- I SORT=2 D STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,practitioner,team
- I SORT=3 D STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
- Q
- ;
-STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
+STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI) ;
  ;IIEN - ien institution
  ;SEC - second sort subscript, IEN team or IEN practitioner
@@ -144,7 +110,8 @@
  N PIEN,PTNAME,PID
  S PIEN=+$P(PINF,"^") ;patient ien 
- S PTNAME=$E($P(PINF,"^",2),1,10) ;patient name
+ S PTNAME=$E($P(PINF,"^",2),1,15) ;patient name
  Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
  S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
+ ;
  I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D
  .;count each unique patient for any given practitioner for grand total
@@ -157,5 +124,5 @@
  S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
  S PID=$P(PINF,"^",3),PID=$TR(PID,"-","")
- S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID ;ssn
+ S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),18)=$E(PID,6,10) ;last 4 pid - 5 places is for any pseudo
  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status
  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility
@@ -166,9 +133,2 @@
  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic
  Q
-STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
- I '$D(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT))  D
- .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$P(PINF,"^",8) ;last appt
- .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$P(PINF,"^",9) ;nxt appt
- .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$E(CNAME,1,15) ;clinic
- .Q
- Q 
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPPAT3.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPPAT3.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPPAT3.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPPAT3 ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:14pm
- ;;5.3;Scheduling;**41,52,148,174,181,177,297,526,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,52,148,174,181,177,297**;AUG 13, 1993
  ;
  ;Listing of Practitioner's Patients
@@ -12,16 +12,9 @@
  .S PT=0
  .F  S PT=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN,PT)) Q:'PT!(STOP)  D
+ ..I (IOST'?1"C-".E),$Y>(IOSL-5) S MORE=0 D NEWP1^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:(('FIRST&'STOP)!($G(SORT)=3)) HEADER
+ ..I (IOST?1"C-".E),$Y>(IOSL-5) S MORE=0 D HOLD^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:'FIRST&'STOP HEADER
+ ..Q:STOP
  ..I FIRST D HEADER S FIRST=0
  ..W !,$G(@STORE@(INS,SEC,TRD,POS,PT)) ;print patient detail line
- ..;I FIRST D HEADER S FIRST=0
- ..N SCCN
- ..S SCCN=""
- ..F  S SCCN=$O(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) Q:SCCN=""  D
- ...W !,$G(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) ;print patient detail line
- ...I (IOST'?1"C-".E),$Y>(IOSL-5) S MORE=0 D NEWP1^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:(('FIRST&'STOP)!($G(SORT)=3)) HEADER
- ...I (IOST?1"C-".E),$Y>(IOSL-5) S MORE=0 D HOLD^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:'FIRST&'STOP HEADER
- ...Q:STOP
- ...;I FIRST D HEADER S FIRST=0
- ...Q
  ..Q
  .Q
@@ -74,5 +67,5 @@
 SHEAD ;
  S @STORE@("H2")="Pt Name"
- S $E(@STORE@("H2"),15)="Pt ID"
+ S $E(@STORE@("H2"),18)="Pt ID"
  S $E(@STORE@("H1"),25)="M.T."
  S $E(@STORE@("H2"),25)="Stat"
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPRAC2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPRAC2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPRAC2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPRAC2 ;ALB/CMM - Practitioner Demographics continued ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,177,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,177**;AUG 13, 1993
  ;
  ;Practitioner Demographics Report
@@ -40,6 +40,5 @@
  .S MAX=$P(NODE,"^",8) ;max patient assignments to position
  .S ASSIGN=+$$PCPOSCNT^SCAPMCU1(PIEN,DT,0) ;assigned patients
- .N CNAME,SCCLIEN
- .D SETASCL(PIEN,.CNAME,.SCCLIEN) ;associated clinics
+ .S CNAME=$P($G(^SC(+$P(NODE,U,9),0)),U) ;associated clinic
  .;
  .;Get preceptor
@@ -57,6 +56,6 @@
  .D SET1("Phone",PHONE),SET2("Pts. Assigned",ASSIGN)
  .I $L($G(PRCP)) D SET3(1,"Preceptor: "_PRCP)
- .D SET3(4,"Assoc. Clinic: ")
- .D SETCNAME(.CNAME)
+ .D SET3(4,"Assoc.")
+ .D SET3(4,"Clinic: "_CNAME)
  .I $L(PCLASS(1)) D
  ..D SET3(4,"Person"),SET3(5,"Class: "_PCLASS(1)) D
@@ -83,10 +82,4 @@
  Q
  ;
-SETASCL(PIEN,CNAME,SCCLIEN) ;SET ASSOCIATED CLINICS
- N I,CNT1
- S CNT1=0,I=0
- F  S I=$O(^SCTM(404.57,PIEN,5,I)) Q:'I  D
- .S SCCLIEN(CNT1)=I,CNAME(CNT1)=$P($G(^SC(I,0)),U),CNT1=CNT1+1
- Q
 SET1(LABEL,VALUE) ;Set output line
  S SCLN=SCLN+1
@@ -109,11 +102,6 @@
  Q
  ;
-SETCNAME(CNAME) ;associated clinics 
- N A
- S A="" F  S A=$O(CNAME(A)) Q:A=""  D SET3(12,CNAME(A))
- Q
- ;
 PINFO(VAE,PRACT,OPH,ROOM,SERV) ;
- ;practitioner information from new person file
+ ;practitioner information form new person file
  S PRACT=$P($G(^VA(200,VAE,0)),"^") ;practitioner name
  S OPH=$P($G(^VA(200,VAE,.13)),"^",2) ;office phone
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPSLT.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPSLT.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPSLT ;ALB/CMM - Summary Listing of Teams ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,52,177,231,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,52,177,231**;AUG 13, 1993
  ;
  ;Summary Listing of Teams Report
@@ -105,5 +105,5 @@
  ;
 PRINTIT(STORE,TITL) ;
- N INST,EINST,ETEAM,TEM,EPRACT,PRACT,NXT,PAGE,NPAGE,NEW,POS,SCAC
+ N INST,EINST,ETEAM,TEM,EPRACT,PRACT,NXT,PAGE,NPAGE,NEW,POS
  S (INST,EINST)="",(NPAGE,STOP)=0,PAGE=1 W:$E(IOST)="C" @IOF
  D TITLE^SCRPU3(.PAGE,TITL)
@@ -130,12 +130,8 @@
  ...S POS=""
  ...F  S POS=$O(@STORE@(INST,TEM,PRACT,POS)) Q:POS=""!(STOP)  D
- ....W !,$G(@STORE@(INST,TEM,PRACT,POS))
- ....S SCAC=""
- ....F  S SCAC=$O(@STORE@(INST,TEM,PRACT,POS,SCAC)) Q:SCAC=""!(STOP)  D
- .....W !,$G(@STORE@(INST,TEM,PRACT,POS,SCAC))
- .....I IOST'?1"C-".E,$Y>(IOSL-4) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE)
- .....I IOST?1"C-".E,$Y>(IOSL-4) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM)
- .....I STOP Q
- ....;W !,$G(@STORE@(INST,TEM,PRACT,POS)) ;writes info
+ ....I IOST'?1"C-".E,$Y>(IOSL-4) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE)
+ ....I IOST?1"C-".E,$Y>(IOSL-4) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM)
+ ....I STOP Q
+ ....W !,$G(@STORE@(INST,TEM,PRACT,POS)) ;writes info
  ..Q:STOP
  ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE,1)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPSLT2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPSLT2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPSLT2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPSLT2 ;ALB/CMM - Summary Listing of Teams Continued ; 9/15/99 10:43am
- ;;5.3;Scheduling;**41,174,177,231,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,174,177,231**;AUG 13, 1993
  ;
  ;Summary Listing of Teams Report
@@ -23,8 +23,6 @@
  S POS=$P(TNODE,"^") ;position name
  ;SD*5.3*231 - call SCMCLK to determine in AP or not
- S PPC=$S($P(TNODE,"^",4)<1:"NPC",+$$OKPREC3^SCMCLK(APOS,DT)>0:" AP",1:"PCP") ;PC?
- ;S PCLIN=$P($G(^SC(+$P(TNODE,"^",9),0)),"^") ;associated clinic
- D SETASCL^SCRPRAC2(APOS,.PCLIN)
- S PCLIN=$G(PCLIN(0))
+ S PPC=$S($P(TNODE,"^",4)<1:"NPC",+$$OKPREC3^SCMCLK(APOS,DT)>1:" AP",1:"PCP") ;PC?
+ S PCLIN=$P($G(^SC(+$P(TNODE,"^",9),0)),"^") ;associated clinic
  S ROLN=$P($G(^SD(403.46,+ROL,0)),U) ;role name
  ;
@@ -57,7 +55,4 @@
  ;
  D FORMAT(APOS,POS,PCLIN,VAE,PRACT,PPC,DIV,TM,NPC,MAX,PCN,XDAT)
- N SCAC
- S SCAC=0
- F  S SCAC=$O(PCLIN(SCAC)) Q:SCAC=""  D FORMATAC(APOS,POS,PCLIN(SCAC),VAE,DIV,TM)
  Q
  ;
@@ -99,7 +94,4 @@
  S $E(@STORE@(DIV,TM,VAE,APOS),128)=$J(TMP(2),5,0) ;precepted NPC
  ;New code ends
- Q
-FORMATAC(APOS,POS,PCLIN,VAE,DIV,TM) ;clinic multiples
- S $E(@STORE@(DIV,TM,VAE,APOS,SCAC),72)=$E(PCLIN,1,30)
  Q
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTA.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTA.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTA.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPTA ;ALB/CMM - Patient Listing w/Team Assignment Data ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,48,52,114,174,181,177,526**;AUG 13, 1993;Build 8
+ ;;5.3;Scheduling;**41,48,52,114,174,181,177**;AUG 13, 1993
  ;
  ;Patient Listing w/Team Assignment Data Report
@@ -149,5 +149,5 @@
  ;setup column headers
  S @STORE@("H2")="Patient Name"
- S $E(@STORE@("H2"),19)="Pt ID"
+ S $E(@STORE@("H2"),24)="Pt ID"
  S $E(@STORE@("H1"),31)="Date"
  S $E(@STORE@("H2"),31)="Assigned"
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTA2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTA2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTA2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPTA2 ;ALB/CMM - Patient Listing w/Team Assignment Data ; 30 Jun 99  1:33 PM
- ;;5.3;Scheduling;**41,88,140,148,174,181,177,526**;AUG 13, 1993;Build 8
+ ;;5.3;Scheduling;**41,88,140,148,174,181,177**;AUG 13, 1993
  ;
  ;Patient Listing w/Team Assignment Data Report continued
@@ -70,6 +70,5 @@
  S PTNAME=$P($G(^DPT(PIEN,0)),"^") ;patient name
  S PID=$P($G(^DPT(PIEN,.36)),"^",3),PID=$TR(PID,"-","")
- ;9 digit ssn SD*5.3*526 - dmr
- ;S PID=$E(PID,6,10) ;last four pid include 5th for pseudo notation
+ S PID=$E(PID,6,10) ;last four pid include 5th for pseudo notation
  ;
  S ADATE=$P(NODE,"^",3) ;position assignment date - fm format
@@ -119,6 +118,6 @@
  S $E(@STORE@(IIEN,TIEN),40)="Primary Care Team: "_$S(PC=1:"YES",1:"NO")
  ;
- S @STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN)=$E(PTNAME,1,17)
- S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),19)=PID
+ S @STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN)=$E(PTNAME,1,21)
+ S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),24)=PID
  S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),31)=ADATE
  S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),43)=PCAP
@@ -140,5 +139,5 @@
  S PTNAME=$E($P($G(^DPT(PIEN,0)),"^"),1,20) ;patient name
  S PID=$P($G(^DPT(PIEN,.36)),"^",3),PID=$TR(PID,"-","")
- ;S PID=$E(PID,6,10) ;9 digit ssn patch 526
+ S PID=$E(PID,6,10) ;last 4 plus 5th for psuedo
  ;
  S TIEN=+$P($G(^SCPT(404.42,PTIEN,0)),"^",3) ;team ien
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTM.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTM.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTM.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPTM ;ALB/CMM - List of Team's Members Report ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,48,52,181,177,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,48,52,181,177**;AUG 13, 1993
  ;
  ;List of Team's Members Report
@@ -154,5 +154,5 @@
 PRNTD(INST,TEM,PRACT,POS,TITL,PAGE,HEAD) ;
  ;
- N CNT,SCAC
+ N CNT
  S CNT=""
  I IOST'?1"C-".E,$Y>(IOSL-11) D NEWP^SCRPTM2(INST,TEM,TITL,.PAGE,.HEAD)
@@ -161,6 +161,3 @@
  F  S CNT=$O(@STORE@(INST,TEM,PRACT,POS,CNT)) Q:CNT=""!(STOP)  D
  .W !,$G(@STORE@(INST,TEM,PRACT,POS,CNT))
- .S SCAC="" I CNT=4  D
- ..F  S SCAC=$O(@STORE@(INST,TEM,PRACT,POS,4,SCAC)) Q:SCAC=""!(STOP)  D
- ...W !,$G(@STORE@(INST,TEM,PRACT,POS,4,SCAC))
  Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTM2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTM2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPTM2 ;ALB/CMM - List of Team's Members Report Continued;01/29/96 ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,140,177,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,140,177**;AUG 13, 1993
  ;
  ;List of Team's Members Report
@@ -31,8 +31,6 @@
  .;
  .S TPNODE=$G(^SCTM(404.57,+TPIEN,0))
- .D SETASCL^SCRPRAC2(TPIEN,.PCLIN)
- .S PCLIN=$G(PCLIN(0))
- .;S PCLIN=+$P(TPNODE,"^",9) ;associated clinic ien
- .;S PCLIN=$P($G(^SC(PCLIN,0)),"^") ;associated clinic name
+ .S PCLIN=+$P(TPNODE,"^",9) ;associated clinic ien
+ .S PCLIN=$P($G(^SC(PCLIN,0)),"^") ;associated clinic name
  .;
  .;Get preceptor
@@ -53,7 +51,4 @@
  .;
  .D FORMAT(PNAME,TPIEN,PCLIN,RNAME,UNAME,ACT,INACT,PRIEN,PRNAME,OPH,ROOM,SERV,INS,TIEN,PRCP,.PCLASS)
- .N SCAC
- .S SCAC=0
- .F  S SCAC=$O(PCLIN(SCAC)) Q:SCAC=""  D FORMATAC(INS,TIEN,PRIEN,TPIEN,PCLIN(SCAC))
  Q
  ;
@@ -110,8 +105,4 @@
  Q
  ;
-FORMATAC(DIV,TEM,PIEN,TPIEN,PCLIN) ;
- S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4,SCAC),49)=$E(PCLIN,1,30)
- Q
- ;
 NEWP(INST,TEM,TITL,PAGE,HEAD) ;
  ;new page
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTP.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPTP ;ALB/CMM - List of Team's Patients ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,48,174,177,526,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,48,174,177**;AUG 13, 1993
  ;
 PROMPTS ;Prompt for Institution, Team, Role, Patient Status and Print device
@@ -20,5 +20,5 @@
  ;ROLE - roles selected (variable and array) 
  ;PSTAT - patient status - 1=all or OPT or AC 
- ;SORT - 1=d,t,ptname 2=d,t,Pt ID 3=d,t,pract,pt name 4=d,t,pract,Pt ID
+ ;SORT - 1=d,t,ptname 2=d,t,last 4 Pt ID 3=d,t,pract,pt name 4=d,t,pract,last 4 Pt ID
  N ZTSAVE,II
  F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(" S ZTSAVE(II)=""
@@ -31,5 +31,5 @@
  ;ROLE - roles selected (variable and array)
  ;PSTAT - patient status - 1=all or OPT or AC
- ;SORT - 1=d,t,ptname 2=d,t,Pt ID 3=d,t,pract,pt name 4=d,t,pract,Pt ID
+ ;SORT - 1=d,t,ptname 2=d,t,last 4 Pt ID 3=d,t,pract,pt name 4=d,t,pract,last 4 Pt ID
  ;IOP - print device
  ;ZTDTH - queue time (optional)
@@ -114,37 +114,5 @@
  Q FOUND
  ;
-FORMAT(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,PINF,ROLN,PCAP) ;Format column information
- ;INS - Institution ien
- ;TIEN - team ien
- ;PTIEN - patient ien
- ;PTNAME - patient name
- ;PID - SSN
- ;PIEN - practitioner ien
- ;PNAME - practitioner name
- ;CNAME - clinic name
- ;LAST - last appointment
- ;NEXT - next appointment
- ;ROLN - role name
- ;PCAP - PC?
- ;
- N SEC,TRD
- I PNAME="" S PNAME="[BAD DATA]"
- I PTNAME="" S PTNAME="[BAD DATA]"
- I PID="" S PID="*********"
- S @STORE@("P",INS,TIEN,PNAME,PIEN)="" ;practitioner
- S @STORE@("PT",INS,TIEN,PTNAME,PTIEN)="" ;patient
- S @STORE@("PID",INS,TIEN,PID,PTIEN)=""
- I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner
- I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner
- S @STORE@(INS,TIEN,SEC,TRD)=$E(PTNAME,1,15) ;patient name
- S $E(@STORE@(INS,TIEN,SEC,TRD),18)=PID ;9 digit pid
- S $E(@STORE@(INS,TIEN,SEC,TRD),32)=$E(PNAME,1,22) ;practitioner name
- S $E(@STORE@(INS,TIEN,SEC,TRD),56)=$E($G(ROLN),1,22) ;role name
- S $E(@STORE@(INS,TIEN,SEC,TRD),80)=$G(PCAP) ;PC?
- S $E(@STORE@(INS,TIEN,SEC,TRD),85)=$P(PINF,"^",8) ;last appointment
- S $E(@STORE@(INS,TIEN,SEC,TRD),97)=$P(PINF,"^",9) ;next appointment
- S $E(@STORE@(INS,TIEN,SEC,TRD),109)=$E(CNAME,1,24) ;clinic name
- Q
-FORMATAC(SCCNT,CNAME,PINF,INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,ROLN,PCAP) ;Format MULTIPLES
+FORMAT(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,LAST,NEXT,ROLN,PCAP) ;Format column information
  ;INS - Institution ien
  ;TIEN - team ien
@@ -170,8 +138,11 @@
  I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner
  I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner
- I '$D(@STORE@(INS,TIEN,SEC,TRD,SCCNT))  D
- .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),85)=$P(PINF,"^",8) ;last appointment
- .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),97)=$P(PINF,"^",9) ;next appointment
- .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),109)=$E(CNAME,1,24) ;clinic name
- .Q
+ S @STORE@(INS,TIEN,SEC,TRD)=$E(PTNAME,1,22) ;patient name
+ S $E(@STORE@(INS,TIEN,SEC,TRD),25)=PID ;last 4 pid
+ S $E(@STORE@(INS,TIEN,SEC,TRD),32)=$E(PNAME,1,22) ;practitioner name
+ S $E(@STORE@(INS,TIEN,SEC,TRD),56)=$E($G(ROLN),1,22) ;role name
+ S $E(@STORE@(INS,TIEN,SEC,TRD),80)=$G(PCAP) ;PC?
+ S $E(@STORE@(INS,TIEN,SEC,TRD),85)=LAST ;last appointment
+ S $E(@STORE@(INS,TIEN,SEC,TRD),97)=NEXT ;next appointment
+ S $E(@STORE@(INS,TIEN,SEC,TRD),109)=$E(CNAME,1,24) ;clinic name
  Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTP2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPTP2 ;ALB/CMM - List of Team's Patients ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,53,52,174,177,231,526,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,53,52,174,177,231**;AUG 13, 1993
  ;
  ;List of Team's Patients Report
@@ -73,7 +73,4 @@
  . . . . Q:STOP
  . . . . I $D(@STORE@(INST,TIEN,PIEN,TRDI)) W !,$G(@STORE@(INST,TIEN,PIEN,TRDI)) ;write column data
- . . . . N SCACL
- . . . . S SCACL="" F  S SCACL=$O(@STORE@(INST,TIEN,PIEN,TRDI,SCACL)) Q:SCACL=""  D
- . . . . . W !,$G(@STORE@(INST,TIEN,PIEN,TRDI,SCACL))
  . S NEW=0
  Q
@@ -102,7 +99,4 @@
  . . . . Q:STOP
  . . . . I $D(@STORE@(INST,TIEN,TRDI,PIEN)) W !,$G(@STORE@(INST,TIEN,TRDI,PIEN)) ;write column data
- . . . . N SCACL
- . . . . S SCACL="" F  S SCACL=$O(@STORE@(INST,TIEN,TRDI,PIEN,SCACL)) Q:SCACL=""  D
- . . . . . W !,$G(@STORE@(INST,TIEN,TRDI,PIEN,SCACL))
  . S NEW=0
  Q
@@ -137,5 +131,5 @@
 SETH ;sets column headings
  S @STORE@("H2")="Patient Name"
- S $E(@STORE@("H2"),18)="Pt ID"
+ S $E(@STORE@("H2"),25)="Pt ID"
  S $E(@STORE@("H2"),32)="Practitioner"
  S $E(@STORE@("H2"),56)="Role"
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP3.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTP3.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP3.m	(revision 636)
@@ -1,5 +1,4 @@
 SCRPTP3 ;ALB/CMM - List of Team's Patients ; 29 Jun 99  04:11PM
- ;;5.3;Scheduling;**41,48,98,177,231,433,526,520**;AUG 13, 1993;Build 26
- ;;DMR BP-OIFO Patch SD*5.3*526
+ ;;5.3;Scheduling;**41,48,98,177,231,433**;AUG 13, 1993
  ;
  ;List of Team's Patients Report
@@ -25,15 +24,54 @@
  .S DFN=PTIEN
  .D PID^VADPT6
- .;S PID=VA("BID")
- .S PID=$E(VA("PID"),1,3)_$E(VA("PID"),5,6)_$E(VA("PID"),8,12)
+ .S PID=VA("BID")
  .;
- .N CNAME,PINF,CLIEN
+ .S TPA=$$TPAR(PTAI,"")
+ .I TPA'=-1 D
+ ..S PIEN=$P(TPA,"^")
+ ..S PNAME=$P(TPA,"^",2)
+ ..S CNAME=$P(TPA,"^",3)
+ ..S LAST=$P(TPA,"^",4)
+ ..S NEXT=$P(TPA,"^",5)
+ ..;
+ ..S FLAG="Y"
+ ..S TINFO=$$TINF^SCRPTP(TIEN) ;team information
+ ..S INST=+$P(TINFO,"^") ;institution ien
+ ..S INAME=$P($G(^DIC(4,INST,0)),"^") ;institution name
+ ..S PHONE=$P(TINFO,"^",4) ;team phone
+ ..S PC=$P(TINFO,"^",3) ;primary care?
+ ..S TNAME=$P(TINFO,"^",2) ;team name
+ ..;
+ ..D TFORMAT^SCRPTP2(INST,INAME,TIEN,TNAME,PHONE,PC)
+ ..D FORMAT^SCRPTP(INST,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,LAST,NEXT)
+ .;
+ .;check for other assignments
+ .N TPIN
  .S CNT=""
  .F  S CNT=$O(^SCPT(404.43,"B",PTAI,CNT)) Q:CNT=""!(CNT'?.N)  D
- ..D TPAR(PTAI,CNT,.PINF,.CNAME,.CLIEN,.PNAME,.ROLN,.PCAP)
+ ..S TPIN=$$TPAR(PTAI,CNT)
+ ..Q:TPIN=-1
+ ..S PIEN=$P(TPIN,"^")
+ ..S PNAME=$P(TPIN,"^",2)
+ ..S CNAME=$P(TPIN,"^",3)
+ ..S LAST=$P(TPIN,"^",4)
+ ..S NEXT=$P(TPIN,"^",5)
+ ..S ROLN=$P(TPIN,U,6)
+ ..S PCAP=$P(TPIN,U,7)
+ ..I '$D(FLAG) D
+ ...S TINFO=$$TINF^SCRPTP(TIEN) ;team information
+ ...S INST=+$P(TINFO,"^") ;institution ien
+ ...S INAME=$P($G(^DIC(4,INST,0)),"^") ;institution name
+ ...S PHONE=$P(TINFO,"^",4) ;team phone
+ ...S PC=$P(TINFO,"^",3) ;primary care?
+ ...S TNAME=$P(TINFO,"^",2) ;team name
+ ...;
+ ...D TFORMAT^SCRPTP2(INST,INAME,TIEN,TNAME,PHONE,PC)
+ ..D FORMAT^SCRPTP(INST,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,LAST,NEXT,ROLN,PCAP)
+ I INACTIVE S @STORE@(INST,TIEN,"INACT")=""
  Q
  ;
-TPAR(PTAI,START,PINF,CNAME,CLIEN,PNAME,ROLN,PCAP) ;
- N PTPA,TPIEN,TPNODE,ROL,CIEN,ENROLL,OKAY,NEXT,LAST,PAIEN
+TPAR(PTAI,START) ;
+ N PTPA,TPIEN,TPNODE,ROL,CNAME,CIEN,ENROLL,OKAY,PNAME,NEXT,LAST,PAIEN
+ N ROLN,PCAP
  I '$D(^SCPT(404.43,"B",PTAI)) Q "0^[Not Assigned]"
  ; ^ no patient team position assignment
@@ -43,5 +81,5 @@
  .S PTPA=START
  I PTPA="" Q "0^[Not Assigned]"
- S PTPAN=$G(^SCPT(404.43,PTPA,0))  ;patient team assignment
+ S PTPAN=$G(^SCPT(404.43,PTPA,0)) ;patient team position assignment node
  I PTPAN=""!(PTPAN=0) Q "0^[Not Assigned]"
  I $P(PTPAN,"^",4)'="",$P(PTPAN,"^",4)<DT Q -1
@@ -57,5 +95,12 @@
  S PCAP=$S($P(PTPAN,U,5)<1:"NPC",+$$OKPREC3^SCMCLK(TPIEN,DT)>0:" AP",1:"PCP") ;PC?
  ;
- D SETASCL^SCRPRAC2(TPIEN,.CNAME,.CLIEN)
+ S CIEN=+$P(TPNODE,"^",9) ;associated clinic ien
+ S CNAME=$P($G(^SC(CIEN,0)),"^") ;clinic name
+ ;check patient status
+ S OKAY=""
+ I CIEN>0&(PSTAT'=1) S OKAY=$$PST^SCRPTP(PTIEN,CIEN)
+ Q:(CIEN>0)&('OKAY)&(PSTAT'=1) -1
+ ; ^ not selected patient status
+ ;
  ;next two lines commented off - SD*5.3*433
  ;S ENROLL=$$ENRL(PTIEN,CIEN) ;enrolled in associated clinic
@@ -67,37 +112,24 @@
  I +PAIEN=0 S PIEN=0,PNAME="[Inactive Position]"
  ;
- D GETPINF^SCRPPAT2(PTIEN,.CLIEN,.PINF)  ;get patient info
- S CNAME=$G(CNAME(0))
- S PINF=$G(PINF(0))
- I PINF="" D
- .S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
- I INACTIVE S @STORE@(INS,TIEN,"INACT")=""
- S FLAG="Y"
- S TINFO=$$TINF^SCRPTP(TIEN) ;team information
- S INST=+$P(TINFO,"^") ;institution ien
- S INAME=$P($G(^DIC(4,INST,0)),"^") ;institution name
- S PHONE=$P(TINFO,"^",4) ;team phone
- S PC=$P(TINFO,"^",3) ;primary care?
- S TNAME=$P(TINFO,"^",2) ;team name
- D TFORMAT^SCRPTP2(INST,INAME,TIEN,TNAME,PHONE,PC)
- D FORMAT^SCRPTP(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,PINF,ROLN,PCAP)
- N SCCNT
- S SCCNT=0 F  S SCCNT=$O(CNAME(SCCNT)) Q:SCCNT=""  D FORMATAC^SCRPTP(SCCNT,CNAME(SCCNT),PINF(SCCNT),INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,ROLN,PCAP)
- Q
+ S (NEXT,LAST)=""
+ I +CIEN>0 S NEXT=$$GETNEXT^SCRPU3(PTIEN,CIEN) ;next appointment
+ I +CIEN>0 S LAST=$$GETLAST^SCRPU3(PTIEN,CIEN) ;last appointment
  ;
-ENRL(PTIEN,CLIEN) ;FUNCTIONALITY DISABLED
+ Q PIEN_U_PNAME_U_CNAME_U_LAST_U_NEXT_U_ROLN_U_PCAP
  ;
- ;N FOUND,ENODE,EN,NXT
- ;S FOUND=0
- ;Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND
- ;S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,""))
- ;Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND
- ;S NXT=""
- ;F  S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N)  D
- ;check if active enrollment
- ;S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0))
- ;I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q  ;not active enrollment
- ;;                      ^ discharge date     ^ enrollment date
+ENRL(PTIEN,CLIEN) ;
+ ;
+ N FOUND,ENODE,EN,NXT
  S FOUND=0
+ Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND
+ S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,""))
+ Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND
+ S NXT=""
+ F  S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N)  D
+ .;check if active enrollment
+ .S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0))
+ .I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q  ;not active enrollment
+ .;                      ^ discharge date     ^ enrollment date
+ .S FOUND=1
  Q FOUND
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPU1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPU1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPU1.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPU1 ;ALB/CMM - GENERIC PROMPTS FOR PCMM REPORTS ;1/12/96
- ;;5.3;Scheduling;**41,45,130,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,45,130**;AUG 13, 1993
  ;
 INST ;Prompt for institution
@@ -109,5 +109,5 @@
  N TRUE,EN,TEAM
  S TRUE=0,EN=""
- F  S EN=$O(^SCTM(404.57,"E",+Y,EN)) Q:EN=""!(TRUE)  D
+ F  S EN=$O(^SCTM(404.57,"D",+Y,EN)) Q:EN=""!(TRUE)  D
  .S TEAM=+$P($G(^SCTM(404.57,EN,0)),"^",2)
  .I $D(VAUTT(TEAM))!(VAUTT=1) S TRUE=1
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPU2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPU2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPU2.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPU2 ;ALB/CMM - GENERIC PROMPTS FOR PCMM REPORTS ; 12 Jan 99  1:23 PM
- ;;5.3;Scheduling;**41,174,297,526,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,174,297**;AUG 13, 1993
  ;
 DTRANG(FIRST,SECOND) ;Date Range - begin date ^ end date => fileman format
@@ -29,5 +29,5 @@
  N TPEN,FOUND,TEAM
  S TPEN="",FOUND=0
- F  S TPEN=$O(^SCTM(404.57,"E",CLN,TPEN)) Q:TPEN=""!(FOUND)  D
+ F  S TPEN=$O(^SCTM(404.57,"D",CLN,TPEN)) Q:TPEN=""!(FOUND)  D
  .S TEAM=$P(^SCTM(404.57,TPEN,0),"^",2)
  .I $D(^SCPT(404.42,"APTTM",DFN,TEAM)) S FOUND=1
@@ -122,14 +122,14 @@
 SORT2() ;Prompt for sorting by:
  ;   [1] Division, Team, Patient Name
- ;or [2] Division, Team, SSN
+ ;or [2] Division, Team, Last 4 Pt ID
  ;or [3] Division, Team, Practitioner, Patient Name
- ;or [4] Division, Team, Practitioner, SSN
+ ;or [4] Division, Team, Practitioner, Last 4 Pt ID
  ;
 EN4 ;
  N X
  W !,"Sort By:",!?10,"[1] Division, Team, Patient Name"
- W !?10,"[2] Division, Team, SSN"
+ W !?10,"[2] Division, Team, Last 4 Pt ID"
  W !?10,"[3] Division, Team, Practitioner, Patient Name"
- W !?10,"[4] Division, Team, Practitioner, SSN"
+ W !?10,"[4] Division, Team, Practitioner, Last 4 Pt ID"
  W !!,"Select 1, 2, 3, or 4: "
  R X:DTIME
@@ -141,6 +141,6 @@
  ;help prompt
  W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Patient Name"
- W !?10,"- 2 to sort by Division, Team, SSN"
+ W !?10,"- 2 to sort by Division, Team, Last 4 Pt ID"
  W !?10,"- 3 to sort by Division, Team, Practitioner, Patient Name"
- W !?10,"- 4 to sort by Division, Team, Practitioner, SSN"
+ W !?10,"- 4 to sort by Division, Team, Practitioner, Last 4 Pt ID"
  Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW24.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW24.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW24.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPW24 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ;06/19/99
- ;;5.3;Scheduling;**144,163,180,254,243,295,329,351,510**;AUG 13, 1993;Build 3
+ ;;5.3;Scheduling;**144,163,180,254,243,295,329,351**;AUG 13, 1993
  ;06/19/99 ACS - Added CPT modifier API calls
  ;
@@ -189,5 +189,5 @@
  ;
 ENROL(SDATE)  ;Get enrollment record (most recent to encounter date)
- N SDY,SDI,X1,X2,X,%Y S:SDATE#1=0 SDATE=SDATE+.9999 S SDI=0 F  S SDI=$O(^DGEN(27.11,"C",+$P(SDOE0,U,2),SDI)) Q:'SDI  S SDY=$G(^DGEN(27.11,SDI,0)),SDY($P($P(^DGEN(27.11,SDI,"U"),U,1),".",1))=SDY  ;SD/510 changed logic to use date/time entered
+ N SDY,SDI,X1,X2,X,%Y S:SDATE#1=0 SDATE=SDATE+.9999 S SDI=0 F  S SDI=$O(^DGEN(27.11,"C",+$P(SDOE0,U,2),SDI)) Q:'SDI  S SDY=$G(^DGEN(27.11,SDI,0)),SDY(+SDY)=SDY
  S SDI=$O(SDY(SDATE),-1) Q:'SDI ""  S X1=$P($P(SDOE0,U),"."),X2=SDI D ^%DTC Q SDY(SDI)
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW6.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW6.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW6.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPW6 ;RENO/KEITH - Trend of Facility Uniques by 12 Month Date Ranges ; 15 Jul 98  02:38PM
- ;;5.3;Scheduling;**139,144,466,510**;AUG 13, 1993;Build 3
+ ;;5.3;Scheduling;**139,144,466**;AUG 13, 1993;Build 2
  N SDDIV,SDI,SDSTA,DIR D TITL^SCRPW50("Trend of Facility Uniques by 12 Month Date Ranges") G:'$$DIVA^SCRPW17(.SDDIV) EXIT
  D SUBT^SCRPW50("**** Status Selection ****")
@@ -7,5 +7,5 @@
  S SDSTA=$S(Y=1:2,Y=2:8,1:"2^8")
 QUE W !!,"This report requires 132 column output.",!
- N ZTSAVE F X="SDDIV","SDDIV(","SDDNU(","SDSTA" S ZTSAVE(X)=""
+ N ZTSAVE F X="SDDIV","SDDIV(","SDDNU(",SDSTA S ZTSAVE(X)=""
  D EN^XUTMDEVQ("UNIQ^SCRPW6","Trend Facility Uniques",.ZTSAVE),DISP0^SCRPW23 Q
 UNIQ ;Calculate/print uniques
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW8.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW8.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW8.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPW8 ;RENO/KEITH - Outpatient Encounter Workload Statistics ; 04 Feb 99  4:53 PM
- ;;5.3;Scheduling;**139,145,144,176,339,466,510**;AUG 13, 1993;Build 3
+ ;;5.3;Scheduling;**139,145,144,176,339,466**;AUG 13, 1993;Build 2
 QS ;Queue outpatient encounter workload report
  D PARM^SCRPW9 Q
@@ -28,10 +28,10 @@
 PRPT ;Print statistics page
  D STOP Q:SDOUT
- S SDCT=0 F SDI=1,2,3,11,14,"8-CC" S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
+ S SDCT=0 F SDI=1,2,3,11,14,8 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
  D XHDR Q:SDOUT  D SHDR("O U T P A T I E N T   E N C O U N T E R   W O R K L O A D") Q:SDOUT  F SDI=11,14,3,1 D LIST(SDI) Q:SDOUT
  I $D(^TMP(SDS1,$J,SDS2,2)) D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"CHECKED OUT" S SDI=0 F  S SDI=$O(^TMP(SDS1,$J,SDS2,2,SDI)) Q:'SDI!SDOUT  S SDSTAT=$O(^TMP(SDS1,$J,SDS2,2,SDI,"")) D COT
- I $D(^TMP(SDS1,$J,SDS2,"8-CC")) D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"INPATIENT APPOINTMENT" S SDI=0 F  S SDI=$O(^TMP(SDS1,$J,SDS2,"8-CC",SDI)) Q:'SDI!SDOUT  S SDSTAT=$O(^TMP(SDS1,$J,SDS2,"8-CC",SDI,"")) D IAP
- D TOT S (SDI,SDCT)=0 F SDI=4,5,6,7,"8-NC",9,12,13 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
- W !! D SHDR("N O N - W O R K L O A D") Q:SDOUT  F SDI="8-NC",12,4,6,5,7,9,10,13 D LIST(SDI) Q:SDOUT
+ I $D(^TMP(SDS1,$J,SDS2,8)) D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"INPATIENT APPOINTMENT" S SDI=0 F  S SDI=$O(^TMP(SDS1,$J,SDS2,8,SDI)) Q:'SDI!SDOUT  S SDSTAT=$O(^TMP(SDS1,$J,SDS2,8,SDI,"")) D IAP
+ D TOT S (SDI,SDCT)=0 F SDI=4,5,6,7,9,12,13 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
+ W !! D SHDR("N O N - W O R K L O A D") Q:SDOUT  F SDI=12,4,6,5,7,9,10,13 D LIST(SDI) Q:SDOUT
  D TOT W !! D SHDR(($$HD2()_"   O U T P A T I E N T   V I S I T S")) Q:SDOUT  S SDCT=^TMP(SDS1,$J,SDS2,"VISIT","NWK")+^TMP(SDS1,$J,SDS2,"VISIT","OWK")
  D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"Act. Req./not accepted visits",?47,$J(^TMP(SDS1,$J,SDS2,"VISIT","NWK"),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"VISIT","NWK")*100/SDCT)),8,2)
@@ -52,5 +52,5 @@
 EXIT K SDTOE0,SDUNCO,SDUNAR,SDCT,DFN,SDDT,SDDTF,SDDTL,SDDTPF,SDDTPL,SDI,SDLINE,SDOE,SDOE0,SDPNOW,SDSTAT,SDSTX,SDTOE,SDTOEE,SDTOE1,SDTX,SDTXS,SDX,SDZ,DTOUT,X,Y,ZTDESC,ZTRTN,ZTSAVE
  D KVA^VADPT K X1,X2,SDH,SDHL,SDPNAM,SDSSN,SDPAGE,SDPT0,SDUL,DUOUT,SDARCT,SDST,SDPNOW,SDMD,SDMC,SDDIV,SDDNAM,SDS1,SDS2,SDCG,SDCLGR F I="SCRPW","SCRPWD","SCRPWC" K ^TMP(I,$J)
- K I,SDFF,SDOUT,SDSTOP,SDNCOU D END^SCRPW50 Q
+ K I,SDFF,SDOUT,SDSTOP D END^SCRPW50 Q
  ;
 HD1() ;Report subheader 1
@@ -83,15 +83,14 @@
  ;
 LIST(SDI) Q:'$D(^TMP(SDS1,$J,SDS2,SDI))  D:$Y>(IOSL-4) XHDR Q:SDOUT
- W !?10,$P(^SD(409.63,+SDI,0),U),?47,$J(^TMP(SDS1,$J,SDS2,SDI),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,SDI)*100/SDCT)),8,2)
+ W !?10,$P(^SD(409.63,SDI,0),U),?47,$J(^TMP(SDS1,$J,SDS2,SDI),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,SDI)*100/SDCT)),8,2)
  Q
  ;
 COT D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT)*100/SDCT)),8,2) Q
  ;
-IAP D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,"8-CC",SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"8-CC",SDI,SDSTAT)*100/SDCT)),8,2) Q
+IAP D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,8,SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,8,SDI,SDSTAT)*100/SDCT)),8,2) Q
 STOP ;Check for stop task request
  S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  ;
 COUNT ;Count encounters
- S SDNCOU=$P($G(^SC(+$P(SDOE0,U,4),0)),U,17),SDNCOU=$S(SDNCOU="Y":1,1:0)
  S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
  D C1("SCRPW",SDDNAM) D:SDMD C1("SCRPWD",SDDIV) D:SDCLGR C1("SCRPWC",SDCG) Q
@@ -99,14 +98,9 @@
 C1(SDS1,SDS2) ;Set ^TMP global
  ;Required input: SDS1,SDS2=subscript values
- ;Because there is only 1 status (8) for INPATIENTS, 8-NC is used to
- ;distinguish the non-count clinics from the count clinics, 8-CC.
- S DFN=$P(SDOE0,U,2),SDSTAT=+$P(SDOE0,U,12) I SDSTAT=8 S SDSTAT=$S(SDNCOU:SDSTAT_"-NC",1:SDSTAT_"-CC")
- I SDZ(0),SDZ(4)=SDDIV,SDS1="SCRPW" D DETAIL
+ S DFN=$P(SDOE0,U,2),SDSTAT=+$P(SDOE0,U,12) I SDZ(0),SDZ(4)=SDDIV,SDS1="SCRPW" D DETAIL
  S ^TMP(SDS1,$J,SDS2,SDSTAT)=$G(^TMP(SDS1,$J,SDS2,SDSTAT))+1
- Q:SDSTAT=4  Q:(+SDSTAT=8)&($P(SDSTAT,"-",2)="NC")  D:"114238"[+SDSTAT VIS Q
+ Q:SDSTAT=4  D:"114238"[SDSTAT VIS Q
  ;
-VIS S ^TMP(SDS1,$J,SDS2,"VISIT",$S(SDSTAT=2:"OWK",(+SDSTAT=8)&('SDNCOU):"OWK",1:"NWK"),DFN,$P(SDDT,"."))="" Q:(+SDSTAT'=2)&(+SDSTAT'=8)
- I +SDSTAT=8,$P(SDOE0,U,7)="" D  Q
- .S ^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required")=$G(^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required"))+1
+VIS S ^TMP(SDS1,$J,SDS2,"VISIT",$S(SDSTAT=2:"OWK",SDSTAT=8:"OWK",1:"NWK"),DFN,$P(SDDT,"."))="" Q:(SDSTAT'=2)&(SDSTAT'=8)
  S SDSTX=$$STX(SDOE,SDOE0),^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2))=$G(^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2)))+1
  Q:$P(SDSTX,U)'=8  S ^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,$P(SDDT,"."))=""
@@ -129,15 +123,10 @@
  ;
 DETAIL ;Set global for detailed list
- N SDIF S SDIF=0
  D ^VADPT S SDPNAM=VADM(1),SDSSN=$P(VADM(2),U)
- I SDZ(1)="U",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)="" Q
- I SDZ(1)="V",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$P(SDDT,"."))="" Q
+ I SDZ(1)="U",SDSTAT'=4 S:"114238"[SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)="" Q
+ I SDZ(1)="V",SDSTAT'=4 S:"114238"[SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$P(SDDT,"."))="" Q
  Q:'$D(SDZ(2))  ; SD*5.3*339
- I SDZ(2)'=2,SDZ(2)=+SDSTAT D  I SDIF Q
- .I (SDZ(2)=8) Q:$P(SDSTAT,"-",2)="CC"  I SDZ(3)'=9 S SDIF=1 Q
- .D DSET S SDIF=1
- Q:("28"'[SDZ(2))!("28"'[+SDSTAT)  Q:SDZ(2)'=+SDSTAT  D  I SDIF Q
- .I +SDSTAT=8,$P(SDSTAT,"-",2)="NC" S SDIF=1 Q
- .I 'SDZ(3) D DSET S SDIF=1
+ I (SDZ(2)'=2)&(SDZ(2)'=8),SDZ(2)=SDSTAT D DSET Q
+ Q:("28"'[SDZ(2))!("28"'[SDSTAT)!(SDZ(2)'=SDSTAT)  I 'SDZ(3) D DSET Q
  D:+$$STX(SDOE,SDOE0)=SDZ(3) DSET Q
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW9.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW9.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW9.m	(revision 636)
@@ -1,4 +1,4 @@
 SCRPW9 ;RENO/KEITH - Outpatient Encounter Workload Statistics (cont.) ; 15 Jul 98  02:38PM
- ;;5.3;Scheduling;**139,144,339,466,510**;AUG 13, 1993;Build 3
+ ;;5.3;Scheduling;**139,144,339,466**;AUG 13, 1993;Build 2
 UNARL(SDS1,SDS2) ;Print list of 'action required'/not accepted uniques
  ;Required input: SDS1,SDS2=subscript values
@@ -34,5 +34,4 @@
  S DIR(0)="S^A:All transmission statuses;1:No transmission record;2:Not required, not transmitted;3:Rejected for transmission;4:Awaiting transmission;"
  S DIR(0)=DIR(0)_"5:Transmitted, no acknowledgment;6:Transmitted, rejected;7:Transmitted, error;8:Transmitted, accepted"
- I SDZ(2)=8 S DIR(0)=DIR(0)_";9:Non-Count (not transmitted)"
  W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDZ(0)=-1 Q  ;SD*5.3*339 add sub-zero
  S SDZ(3)=+Y
@@ -47,5 +46,5 @@
  K SDH S SDPAGE=1,SDH(1)="<*>  DETAILED LIST OF DIVISION "_$S(SDZ(1)="U":"UNIQUES",SDZ(1)="V":"VISITS",1:"ENCOUNTERS")_"  <*>",SDH(2)="For division: "_SDZ(4)
  I $G(SDZ(2)) S SDH(3)="Encounters with "_$P(^SD(409.63,SDZ(2),0),U)_" status"
- I $G(SDZ(2))'="","28"[SDZ(2) S SDH(4)="Transmission status: "_$P($T(TXS+SDZ(3)),";",2)
+ I "28"[$G(SDZ(2)) S SDH(4)="Transmission status: "_$P($T(TXS+SDZ(3)),";",2)
  D DHDR Q:SDOUT  I '$D(^TMP(SDS1,$J,SDS2,"DETAIL")) W !,"No records found in this category." Q
  S SDCT=0 D @SDZ(1) Q
@@ -90,5 +89,4 @@
  ;Transmitted, error
  ;Transmitted, accepted
- ;Non-Count (not transmitted)
  ;
 PARM ;Prompt for report parameters
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMBAE2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDAMBAE2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMBAE2.m	(revision 636)
@@ -1,4 +1,4 @@
 SDAMBAE2 ;ALB/BOK - ADD/EDIT CON'T ;11/21/91  12:15 ;
- ;;5.3;Scheduling;**15,79,111,132**;Aug 13, 1993
+ ;;5.3;Scheduling;**15,79,111,132**;Aug 13, 1993;Build 1
  ;
 APP ; -- screen on APPOINTMENT TYPE field in VISIT file CLINIC STOP multiple
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMBAE3.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDAMBAE3.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMBAE3.m	(revision 636)
@@ -1,4 +1,4 @@
 SDAMBAE3 ;ALB/BOK/MJK - ADD/EDIT CON'T ;7/8/91  12:18 ;
- ;;5.3;Scheduling;**18,29,40,111,132**;Aug 13, 1993
+ ;;5.3;Scheduling;**18,29,40,111,132**;Aug 13, 1993;Build 1
  ;
 DUP ; -- inp transform to check for duplicate CPTs in ^DD(409.51,21:25,0)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMODO3.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDAMODO3.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMODO3.m	(revision 636)
@@ -1,4 +1,4 @@
 SDAMODO3 ;ALB/SCK - PROVIDER DIAGNOSTICS REPORT OUTPUT ; 05 Oct 98  8:44 PM
- ;;5.3;Scheduling;**11,25,46,49,159,529**;Aug 13, 1993;Build 3
+ ;;5.3;Scheduling;**11,25,46,49,159**;Aug 13, 1993
  Q
 REPORT ;
@@ -96,5 +96,5 @@
  N Y S Y=1
  I PDIAG=1 G SELDXQ
- S DIC="^ICD9(",DIC(0)="XMS",X=DX_" "  ;SD/529
+ S DIC="^ICD9(",DIC(0)="MZ",X=DX
  D ^DIC K DIC I Y<0 S Y=0 G SELDXQ
  I $D(PDIAG($P(Y,U))) G SELDXQ
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT ; GENERATED FROM 'SDB' INPUT TEMPLATE(#485), FILE 44;05/05/06
+SDBT ; GENERATED FROM 'SDB' INPUT TEMPLATE(#485), FILE 44;10/02/06
  D DE G BEGIN
 DE S DIE="^SC(",DIC=DIE,DP=44,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^SC(DA,""))=""
@@ -148,5 +148,5 @@
 C12 G C12S:$D(DE(12))[0 K DB
 C12S S X="" G:DG(DQ)=X C12F1 K DB
-C12F1 N X,X1,X2 S DIXR=458 D C12X1(U) K X2 M X2=X D C12X1("O") K X1 M X1=X
+C12F1 N X,X1,X2 S DIXR=473 D C12X1(U) K X2 M X2=X D C12X1("O") K X1 M X1=X
  I $G(X(1))]"" D
  . K ^SC("AST",X,DA)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT1.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT1 ; ;05/05/06
+SDBT1 ; ;10/02/06
  S X=DE(19),DIC=DIE
  K ^SC("ALTP",$E(X,1,30),DA)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT10.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT10.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT10.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT10 ; ;05/05/06
+SDBT10 ; ;10/02/06
  D DE G BEGIN
 DE S DIE="^SC(",DIC=DIE,DP=44,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^SC(DA,""))=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT11.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT11.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT11.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT11 ; ;04/26/05
+SDBT11 ; ;11/16/05
  D DE G BEGIN
 DE S DIE="^SC(",DIC=DIE,DP=44,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^SC(DA,""))=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT2.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT2 ; ;05/05/06
+SDBT2 ; ;10/02/06
  S X=DG(DQ),DIC=DIE
  S ^SC("ALTP",$E(X,1,30),DA)=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT3.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT3.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT3.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT3 ; ;05/05/06
+SDBT3 ; ;10/02/06
  S X=DE(20),DIC=DIE
  K ^SC("ALTC",$E(X,1,30),DA)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT4.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT4.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT4.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT4 ; ;05/05/06
+SDBT4 ; ;10/02/06
  S X=DG(DQ),DIC=DIE
  S ^SC("ALTC",$E(X,1,30),DA)=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT5.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT5.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT5.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT5 ; ;05/05/06
+SDBT5 ; ;10/02/06
  D DE G BEGIN
 DE S DIE="^SC(",DIC=DIE,DP=44,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^SC(DA,""))=""
@@ -141,5 +141,5 @@
 C16 G C16S:$D(DE(16))[0 K DB
 C16S S X="" G:DG(DQ)=X C16F1 K DB
-C16F1 N X,X1,X2 S DIXR=457 D C16X1(U) K X2 M X2=X D C16X1("O") K X1 M X1=X
+C16F1 N X,X1,X2 S DIXR=472 D C16X1(U) K X2 M X2=X D C16X1("O") K X1 M X1=X
  I $G(X(1))]"" D
  . K ^SC("ACST",X,DA)
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT6.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT6.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT6.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT6 ; ;05/05/06
+SDBT6 ; ;10/02/06
  D DE G BEGIN
 DE S DIE="^SC(D0,""PR"",",DIC=DIE,DP=44.1,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SC(D0,"PR",DA,""))=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT7.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT7.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT7.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT7 ; ;05/05/06
+SDBT7 ; ;10/02/06
  D DE G BEGIN
 DE S DIE="^SC(D0,""DX"",",DIC=DIE,DP=44.11,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SC(D0,"DX",DA,""))=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT8.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT8.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT8.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT8 ; ;05/05/06
+SDBT8 ; ;10/02/06
  D DE G BEGIN
 DE S DIE="^SC(D0,""SDPRIV"",",DIC=DIE,DP=44.04,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SC(D0,"SDPRIV",DA,""))=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT9.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDBT9.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDBT9.m	(revision 636)
@@ -1,3 +1,3 @@
-SDBT9 ; ;05/05/06
+SDBT9 ; ;10/02/06
  D DE G BEGIN
 DE S DIE="^SC(D0,""SI"",",DIC=DIE,DP=44.03,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SC(D0,"SI",DA,""))=""
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDC.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDC.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDC.m	(revision 636)
@@ -1,4 +1,4 @@
 SDC ;MAN/GRR,ALB/LDB - CANCEL A CLINIC'S AVAILABILITY ; 3/2/05 2:11pm
- ;;5.3;Scheduling;**15,32,79,132,167,478,487,523**;Aug 13, 1993;Build 6
+ ;;5.3;Scheduling;**15,32,79,132,167,478,487**;Aug 13, 1993
  N SDATA,SDCNHDL ; for evt dvr
 SDC1 K SDLT,SDCP S NOAP="" D LO^DGUTL
@@ -39,11 +39,9 @@
  D S S ^(1)="   "_$E(SD,6,7)_"    **CANCELLED**",FR=SD,TO=SD+.9 ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
 C S FR=$O(^SC(SC,"S",FR)) I FR<1!(FR'<TO) W !!,"CANCELLED!  " K SDX G CHKEND^SDC0
- N TDH,TMPD,DIE,DR,NODE
+ N TDH,TMPD,DIE,DR
  F I=0:0 S I=$O(^SC(SC,"S",FR,1,I)) Q:I'>0  D
  .S DFN=+^SC(SC,"S",FR,1,I,0),SDCNHDL=$$HANDLE^SDAMEVT(1)
  .D BEFORE^SDAMEVT(.SDATA,DFN,FR,SC,I,SDCNHDL)
  .S $P(^SC(SC,"S",FR,1,I,0),"^",9)="C"
- .S:$D(^DPT(DFN,"S",FR,0)) NODE=^(0)  ;added SD/523
- .Q:$P(NODE,U,1)'=SC                  ;added SD/523
  .S ^DPT("ASDCN",SC,FR,DFN)=""
  .S SDSC=SC,SDTTM=FR,SDPL=I,TDH=DH,TMPD=CANREM D CANCEL^SDCNSLT S DH=TDH ;SD/478
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCLAS.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDCLAS.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCLAS.m	(revision 636)
@@ -1,4 +1,4 @@
 SDCLAS ;ALB/TMP,MRY - Clinic Assignment List Extract ;12/23/92  11:42
- ;;5.3;Scheduling;**63,243,517,523**;Aug 13, 1993;Build 6
+ ;;5.3;Scheduling;**63,243,517**;Aug 13, 1993;Build 4
  ;SD/517 CORRECTED ALL $NEXT FUNCTIONAL COMMANDS
  S DIV="" D DIV^SDUTL I $T D CALST^SDDIV Q:Y<0
@@ -14,10 +14,10 @@
  S PGM="START^SDCLAS",VAR="SDIFN^SDSRT^DIV^SDTS^SDSAV^SDFAST",VAL=SDIFN_"^"_SDSRT_"^"_DIV_"^"_SDTS_"^"_SDSAV_"^"_SDFAST D ZIS^DGUTQ Q:POP
 START K ^UTILITY($J) S SDSTOP=$S(SDSRT="S":SDIFN,1:""),SD1="",U="^" U IO G:SDIFN="ALL"!(SDSRT="S")!(SDSAV]"") ALL
-ONE S ONE=1 D INIT F SDAPPT=SDTS:0 S SDAPPT=$O(^SC(SDIFN,"S",SDAPPT)) Q:SDAPPT'>0  D PT
+ONE S ONE=1 D INIT S SDAPPT=0 F  S SDAPPT=$O(^SC(SDIFN,"S",SDAPPT)) Q:'SDAPPT  D PT
  D:'SDFAST AEB^SDCLAS0 G ^SDCLAS1
 ALL S ONE=0 I SDSAV']"" S SDIFN=0 F  S SDIFN=$O(^SC(SDIFN)) Q:'SDIFN  I $P(^(SDIFN,0),"^",3)="C" D APPT
  I SDSAV]"" D APART S SDIFN=0 F  S SDIFN=$O(SDZ(SDIFN)) Q:'SDIFN  I $D(^SC(SDIFN,0)),$P(^(0),"^",3)="C" D APPT
  G ^SDCLAS1
-APPT D CHECK I 'POP K ^UTILITY($J,"PAT",SDIFN) D INIT F SDAPPT=SDTS:0 S SDAPPT=$O(^SC(SDIFN,"S",SDAPPT)) D:SDAPPT>0 PT I SDAPPT'>0 D:'SDFAST AEB^SDCLAS0 Q
+APPT D CHECK I 'POP K ^UTILITY($J,"PAT",SDIFN) D INIT S SDAPPT=0 F  S SDAPPT=$O(^SC(SDIFN,"S",SDAPPT)) D:SDAPPT PT I 'SDAPPT D:'SDFAST AEB^SDCLAS0 Q
  Q
 PT S SD=0 F  S SD=$O(^SC(SDIFN,"S",SDAPPT,1,SD)) Q:'SD  Q:'$D(^(SD,0))  S DFN=+^(0) D PT1
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCLAV0.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDCLAV0.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCLAV0.m	(revision 636)
@@ -1,11 +1,9 @@
 SDCLAV0 ;ALB/LDB - OUTPUT PATTERNS (cont.) ; 05 Mar 99 11:31 AM
- ;;5.3;Scheduling;**184,439,490,517,529**;Aug 13, 1993;Build 3
+ ;;5.3;Scheduling;**184,439,490,517**;Aug 13, 1993;Build 4
  ;SD/517 CHANGED FOR LOOPS
  I 'VAUTC S SDC=0 F  S SDC=$O(VAUTC(SDC)) Q:'SDC  S SDV=VAUTC(SDC) D:VAUTD!($D(VAUTD(+$P(^SC(SDC,0),"^",15))))!('$P(^(0),"^",15)&$D(VAUTD($P(^DG(43,1,"GL"),"^",3)))) S1
  I VAUTC S SDC=0 F  S SDC=$O(^SC(SDC)) Q:'SDC  I $P(^(SDC,0),"^",3)="C" D:VAUTD!($D(VAUTD(+$P(^(0),"^",15))))!('$P(^(0),"^",15)&$D(VAUTD($P(^DG(43,1,"GL"),"^",3)))) S1
  I $D(^UTILITY($J,"SDNMS")) D S2^SDCLAV1
- ;following line commented off per SD*529
- ;S DGTCH="CLINIC AVAILABILITY REPORT^CLINIC^PAGE#" D:$E(IOST,1,2)="P-" TP^DGUTL K SDBD,SDCI,SDED D END^SDCLAV Q
- D END^SDCLAV Q
+ S DGTCH="CLINIC AVAILABILITY REPORT^CLINIC^PAGE#" D:$E(IOST,1,2)="P-" TP^DGUTL K SDBD,SDCI,SDED D END^SDCLAV Q
 S1 S SD=^SC(SDC,0),D=$S($P(SD,"^",15):$P(SD,"^",15),1:$P(^DG(43,1,"GL"),"^",3)),SD5=0,SDNM=$P(SD,"^")
  S $P(^UTILITY($J,"SDNMS",D,SDNM),"^",3)=SDC
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCWL2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDCWL2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCWL2.m	(revision 636)
@@ -1,4 +1,4 @@
 SDCWL2 ;ALB/MLI - CONTINUATION OF CLINIC WORKLOAD REPORTS ; 07 Mar 99  6:41 PM
- ;;5.3;Scheduling;**140,132,171,184,529**;Aug 13, 1993;Build 3
+ ;;5.3;Scheduling;**140,132,171,184**;Aug 13, 1993
 PRO S SDAS=$S($P(^SC(I,"S",J,1,K,0),U,9)="C":"C",1:$P(^DPT(DFN,"S",J,0),U,2)) S SDP=$P(^DPT(DFN,"S",J,0),U,7)
 PRO1 S SDP=$P(^DPT(DFN,"S",J,0),U,7) S:SDS="C" ^(SDN)=$S($D(^TMP($J,"CL",'$D(SDFL),SDN)):^(SDN),1:0)
@@ -9,5 +9,5 @@
  Q:$D(SDFL)!(SDRT="B")  S SDAPT=$S(SDF="D":J\1,1:J\100) S:'$D(^TMP($J,1,SDN,SDAPT)) (^(SDAPT,"CA"),^("NS"),^("IN"),^("OB"),^("UN"),^("SD"))=0
  S TIME=$E($P(J,".",2)_"0000",1,4),TIME=$E(TIME,1,2)_":"_$E(TIME,3,4)
- S:SDNAM SDPN=$E($P(^DPT(DFN,0),U),1,20),SDSSN=$S($P(^(0),U,9)]"":$P(^(0),U,9),1:0),^TMP($J,1,SDN,SDAPT,"NM",SDPN,SDSSN,TIME,$S(SDAS]"":SDAS,SDOB:"OB",SDP=1:"S",SDP=3:"S",SDP=4:"U",1:" "))=""  ;added SDP=1 SD*529
+ S:SDNAM SDPN=$E($P(^DPT(DFN,0),U),1,20),SDSSN=$S($P(^(0),U,9)]"":$P(^(0),U,9),1:0),^TMP($J,1,SDN,SDAPT,"NM",SDPN,SDSSN,TIME,$S(SDAS]"":SDAS,SDOB:"OB",SDP=3:"S",SDP=4:"U",1:" "))=""
  K TIME I SDAS["C" S ^("CA")=^TMP($J,1,SDN,SDAPT,"CA")+1 Q
  I SDAS="N"!(SDAS="NA") S ^("NS")=^TMP($J,1,SDN,SDAPT,"NS")+1 Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDD0.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDD0.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDD0.m	(revision 636)
@@ -1,4 +1,4 @@
 SDD0 ;SF/GFT,ALB/BOK,JSH,LDB - REMAP A CLINIC ; 26 JAN 84  3:00 pm
- ;;5.3;Scheduling;**167,401,529**;Aug 13, 1993;Build 3
+ ;;5.3;Scheduling;**167,401**;Aug 13, 1993
 SETX ;
  N SDDIV
@@ -8,5 +8,5 @@
  S:SI=1 SI=4 S:SI=2 SI=4 S SDSOH=$S($P(SDSL,U,8)']"":0,1:1)
  K SDIN,SDRE,SDRE1 N SDNODE I $D(^SC(SC,"I")) S SDIN=+^("I"),SDRE=+$P(^("I"),"^",2),Y=SDRE D DTS^SDUTL S SDRE1=Y
- F DATE=$$FMADD^XLFDT(SDBD,-1):0 S X1=DATE,X2=1 N X D C^%DTC S DATE=X S SDNODE=$D(^SC(SC,"ST",DATE)) Q:DATE'>0!(DATE>SDED)  I $S('$D(SDIN):1,'SDIN:1,SDIN>DATE:1,SDRE'>DATE&(SDRE):1,1:0) K SM,SDHOL D CHECK  ;changed 1st part of For loop SD*529
+ F DATE=SDBD-1:0 S X1=DATE,X2=1 N X D C^%DTC S DATE=X S SDNODE=$D(^SC(SC,"ST",DATE)) Q:DATE'>0!(DATE>SDED)  I $S('$D(SDIN):1,'SDIN:1,SDIN>DATE:1,SDRE'>DATE&(SDRE):1,1:0) K SM,SDHOL D CHECK
  Q
 CHECK S X=DATE D DW^%DTC S DAY=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,Y+1),DOW=Y
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDLT.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDLT.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDLT.m	(revision 636)
@@ -1,4 +1,4 @@
 SDLT ;ALB/LDB - CANCELLATION LETTERS ; 14 Feb 2003
- ;;5.3;Scheduling;**185,213,281,330,398,523**;Aug 13, 1993;Build 6
+ ;;5.3;Scheduling;**185,213,281,330,398**;Aug 13, 1993
  ;
  ;**************************************************************************
@@ -14,7 +14,5 @@
  ;
  ;WRITE GREETING AND OPENING TEXT OF LETTER
-PRT S DFN=$P(A,U,1)  ;SD*523
- I $D(SDNOSH) I $D(^DPT(DFN,.1)) S POP=1 Q:POP  ;SD/523
- S Y=DT D DTS^SDUTL
+PRT S Y=DT D DTS^SDUTL
  I +$G(SDFIRST)=0 W @IOF ;SD*5.3*330 Form feed only after letter #1
  K SDFIRST
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDN1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDN1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDN1.m	(revision 636)
@@ -1,4 +1,4 @@
 SDN1 ;BSN/GRR - NO-SHOW LETTERS ; 17 AUG 84  4:34 pm
- ;;5.3;Scheduling;**330,340,398,455,523**;Aug 13, 1993;Build 6
+ ;;5.3;Scheduling;**330,340,398,455**;Aug 13, 1993
  N SDBAD
  I ANS["Y"&($D(C)) F A=0:0 S A=$O(^UTILITY($J,A)) Q:A'>0  F C=0:0 S C=$O(^(A,C)) Q:C'>0  S SC=+^(C),SDLET="" S:$D(^SC(SC,"LTR")) SDLET=+^("LTR") S:SDLET ^UTILITY($J,"SDLT",SDLET,A,C)=^UTILITY($J,A,C) S:'SDLET ^UTILITY($J,"NO",A,C)=SC D KLL
@@ -9,5 +9,5 @@
 LST1 F C=0:0 S C=$O(^SC(C)) Q:C'>0  D LT,CHECK1 I $T,$S(SDV1="":1,SDV=SDV1:1,SDV="":1,1:0),'$D(SDVAUTC(+C)),$D(^SC(C,"S")) D OVER
 LST N SDFIRST S SDFIRST=1
- F SDLET=0:0 S SDLET=$O(^UTILITY($J,"SDLT",SDLET)) Q:SDLET'>0  F A=0:0 S A=$O(^UTILITY($J,"SDLT",SDLET,A)) Q:A'>0  I $S('$D(^DPT(A,.35)):1,$P(^(.35),"^",1)']"":1,1:0) N POP S POP=0 D ^SDLT Q:POP  D WR  ;SD*523 added quit
+ F SDLET=0:0 S SDLET=$O(^UTILITY($J,"SDLT",SDLET)) Q:SDLET'>0  F A=0:0 S A=$O(^UTILITY($J,"SDLT",SDLET,A)) Q:A'>0  I $S('$D(^DPT(A,.35)):1,$P(^(.35),"^",1)']"":1,1:0) D ^SDLT,WR
  I $D(^UTILITY($J,"NO")) W @IOF F A=0:0 S A=$O(^UTILITY($J,"NO",A)) Q:A'>0  F A1=0:0 S A1=$O(^(A,A1)) Q:A1'>0  Q:$$BADADR^DGUTL3(A)  W !,$P(^DPT(A,0),"^")," ",$P(^(0),"^",9)," has failed to keep the following appointment(s):" D NDT
  W:$D(^UTILITY($J,"NO")) !,"However, there are no letters assigned to the clinic(s).",!!
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDNOS0.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDNOS0.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDNOS0.m	(revision 636)
@@ -1,4 +1,4 @@
 SDNOS0 ;ALB/LDB - NO SHOW REPORT ; 07 May 99 10:21 AM
- ;;5.3;Scheduling;**20,194,410,517,523**;Aug 13, 1993;Build 6
+ ;;5.3;Scheduling;**20,194,410,517**;Aug 13, 1993;Build 4
  D END1^SDNOS
  S (SDV1,SDIN,SDNM,SDNM1)=0,SDDIVO=SDDIV
@@ -33,6 +33,5 @@
  Q
  ;Added 2nd Quit below SD/517
- ;SD/523 - added Q:SDPAT="" to For loop
-CHK S SDAPP=0 F  S SDAPP=$O(^SC(SDCL,"S",SDBEG1,1,SDAPP)) Q:'SDAPP  Q:'$D(^(SDAPP,0))  I $D(^SC(SDCL,"S",SDBEG1,1,SDAPP))=10,$P(^(SDAPP,0),U,9)'="C" S SDPAT=$P(^SC(SDCL,"S",SDBEG1,1,SDAPP,0),U,1) Q:SDPAT=""  I $D(^DPT(SDPAT,"S",SDBEG1)) D CHK1
+CHK S SDAPP=0 F  S SDAPP=$O(^SC(SDCL,"S",SDBEG1,1,SDAPP)) Q:'SDAPP  Q:'$D(^(SDAPP,0))  I $D(^SC(SDCL,"S",SDBEG1,1,SDAPP))=10,$P(^(SDAPP,0),U,9)'="C" S SDPAT=$P(^SC(SDCL,"S",SDBEG1,1,SDAPP,0),U,1) I $D(^DPT(SDPAT,"S",SDBEG1)) D CHK1
  Q
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDPFSS.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDPFSS.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDPFSS.m	(revision 636)
@@ -1,4 +1,21 @@
-SDPFSS ;ALB/SCK - Patient Financial Services System  ;22-APR-2005
- ;;5.3;Scheduling;**430**;Aug 13, 1993
+SDPFSS ;ALB/SCK - Patient Financial Services System  ;11/24/0622-APR-2005
+ ;;5.3;Scheduling;**430,502**;Aug 13, 1993  ;Build 14
+ ; Modified from FOIA VISTA,
+ ; Copyright (C) 2007 WorldVistA
+ ;
+ ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU General Public License as published by
+ ; the Free Software Foundation; either version 2 of the License, or
+ ; (at your option) any later version.
+ ;
+ ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU General Public License for more details.
+ ;
+ ; You should have received a copy of the GNU General Public License
+ ; along with this program; if not, write to the Free Software
+ ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+ ;
  ;
  Q
@@ -11,12 +28,20 @@
  ; Check conditions before proceeding
  Q:'$G(DFN)
+ ; VWSD LOCAL MOD HERE SDVWNVAI VARIABLE, SEE DEFINITION AT VWSD LOCAL MOD BELOW
+ I $D(SDVWNVAI) G OVER
  Q:'$$CHECK
+OVER ;
+ ;END LOCAL MOD
  Q:$$TESTPAT^VADPT(DFN)
- ;
+ ;VWSD LOCAl MOD
  ; Call the ICN API to generate an ICN if one does not exist for the patient.
+ ;VWSD SDVWNVAI VARIABLE -LOCAL MOD FOR disabling the need for ICN or use of other ICN system for non-VA system
  S SDOK=$$ICNLC^MPIF001(DFN)
- I SDOK<0 D
+ I $D(SDVWNVAI) G OVER1
+ I (SDOK<0) D
  . D ERRMSG^SDPFSS2(SDOK)
  ;
+OVER1 ;
+ ;END LOCAL MOD
  ; Get event type
  S SDEVENT=$S($D(SDAMEVT):$$GET1^DIQ(409.66,SDAMEVT,.01),1:"OTHER")
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLE.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLE.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLE.m	(revision 636)
@@ -1,4 +1,4 @@
-SDWLE ;BPOI/TEH - WAITING LIST-ENTER/EDIT;06/12/2002
- ;;5.3;scheduling;**263,415,446,524**;08/13/93;Build 29
+SDWLE ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002  2:10 PM
+ ;;5.3;scheduling;**263,446**;AUG 13 1993;Build 77
  ;
  ;
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLI.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLI.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLI.m	(revision 636)
@@ -1,4 +1,4 @@
-SDWLI ;BPOI/TEH - DISPLAY PENDING APPOINTMENTS;6/1/05
- ;;5.3;scheduling;**263,327,394,446,524**;08/13/93;Build 29
+SDWLI ;IOFO BAY PINES/TEH - DISPLAY PENDING APPOINTMENTS ; 6/1/05 12:56pm  ; Compiled April 16, 2007 10:00:47
+ ;;5.3;scheduling;**263,327,394,446**;AUG 13 1993;Build 77
  ;
  ;
@@ -30,9 +30,9 @@
  ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
  ;
- D SEL G EN:$D(DUOUT)
  D PAT Q:'$D(SDWLDFN)
  G END:SDWLDFN<0,END:SDWLDFN=""
  Q:$D(DUOUT)
 EN1 K DIR,DIC,DR,DIE,SDWLDRG
+ D SEL G EN:$D(DUOUT)
  D GETFILE
  D DISP G EN:'$D(DUOUT)
@@ -40,6 +40,4 @@
  Q
 PAT ;PATIENT LOOK-UP
- ;PATCH SD*5.3*524 - SET DIC("S") FOR SCREEN OF OPEN/CLOSED ENTRIES
- S DIC("S")="I $D(SDWLY),SDWLY,$P(^SDWL(409.3,+Y,0),U,17)=""O"""
  S DIC(0)="EMNQA",DIC=409.3 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,2)
  G PATEND:SDWLDFN=""
@@ -51,5 +49,5 @@
  ;PROMPT FOR DISPLAY 'OPEN' WAITING LIST ONLY OR PROMPT FOR BEGINNING AND ENDING DATES
  ;
-SEL K SDWLDRG S DIR(0)="Y" S DIR("A")="Do You Want to View Only 'OPEN' Wait Lists",DIR("B")="YES"
+SEL K SDWLDRG S DIR(0)="YAO^^" S DIR("A")="Do You Want to View Only 'OPEN' Wait Lists? Yes// "
  S DIR("?")="'Yes' for 'Open' and these Patient Record have not been dispositioned and 'No' for all Records."
  W ! D ^DIR S SDWLY=Y W !
@@ -104,5 +102,5 @@
  .S X=$G(^TMP("SDWLI",$J,SDWLCNT)),SDWLDA=$P(X,"~",2),SDWLIN=$P(X,U,3),SDWLCL=$P(X,U,4),SDWLTY=$P(X,U,5),SDWLPRI=$P(X,U,11)
  .S SDWLTYP=$S(SDWLTY=1:$P(X,U,6),SDWLTY=2:$P(X,U,7),SDWLTY=3:$P(X,U,8),SDWLTY=4:$P(X,U,9),1:"")
- .S SDWLTYN=$S(SDWLTY=1:5,SDWLTY=2:6,SDWLTY=3:7,SDWLTY=4:8),SDWLCOM=$P($P(X,U,18),"~",1)
+ .S SDWLTYN=$S(SDWLTY=1:5,SDWLTY=2:6,SDWLTY=3:7,SDWLTY=4:8,1:0),SDWLCOM=$P($P(X,U,18),"~",1)
  .S SDWLDUZ=$P(X,U,10),SDWLPRV=$P(X,U,12),SDWLPROV=$P(X,U,13),SDWLX=$P(X,"~",3) D
  ..I $D(SDWLDISX) S SDWLDIS=$P(SDWLDISX,U,1),SDWLDDUZ=$P(SDWLDISX,U,2),SDWLDIDT=$P(SDWLDISX,U,3)
@@ -165,4 +163,3 @@
  K SDWLDRG,SDWLDT,SDWLDTD,SDWLDTP,SDWLDUZ,SDLWEDT,SDWLIN,SDLWP,SDWLPRI,SDWLPROV,SDLWPRV,SDWLSC,SDWLSP,SDWLSS,SDLWST,SDWLTY
  K SDWLTYN,SDSWLTYP,SDLWX,SDWLY,SDWRB,SDWLBDT,SDWLDISC,SDWLERR,SDWLPRON,SDXSCAT,SDWLP,SDWLTYP
- K SDREMD,SDREMDD,SDREMR,SDREMRC,SDREMU,MM,SDWLEDT,SDWLLIST,SDWLST,SDWLX,VA,X,Y,YY
  Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLQSR.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLQSR.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLQSR.m	(revision 636)
@@ -1,4 +1,4 @@
-SDWLQSR ;BPOI/TEH - WAIT LIST STAT REPORT;06/12/02
- ;;5.3;scheduling;**263,425,448,524**;08/13/93;Build 29
+SDWLQSR ;;IOFO BAY PINES/TEH/WAIT LIST STAT REPORT
+ ;;5.3;scheduling;**263,425,448**;AUG 13 1993
  ;
  ;
@@ -7,9 +7,7 @@
  ;
 EN N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,POP
- K ^TMP("SDWLQSR",$J)
  D HD
 1 D INS G END:$D(DUOUT)
 2 D DATE G END:$D(DUOUT)
-3 D EXCL G END:$D(DUOUT)
  D QUE G END:$D(DUOUT)
  Q
@@ -35,14 +33,4 @@
  S ^TMP("SDWLQSR",$J,"DATE")=SDWLBDT_"^"_SDWLEDT K DIR,DIC,DIE,%DT Q
  Q
-EXCL ;EXCLUDE # REMAINING =0 - PATCH SD*5.3*524
- S SDWLEXCL=0,^TMP("SDWLQSR",$J,"EXCL")=0
- S DIR("A",1)="Do you wish to exclude any Teams, Specialities or Specific"
- S DIR("A")="Clinics where ALL values are zero"
- S DIR("B")="YES",DIR(0)="Y^A0" D ^DIR
- I X["^" S DUOUT=1 Q
- I Y<0 S DUOUT=1 Q
-EXCL1 I Y S SDWLEXCL=1,^TMP("SDWLQSR",$J,"EXCL")=SDWLEXCL
- K DIR,X,Y,SDWLEXCL
- Q
 QUE ;Queue Report
  N ZTQUEUED,POP
@@ -60,7 +48,5 @@
  D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  Q
-END D EN^SDWLKIL
- K DUOUT,SDWLBDT,SDWLEDT,SDWLERR,SDWLIST,SDWLPROM,SDWLTK
- Q
+END D EN^SDWLKIL Q
 HD ;
  W:$D(IOF) @IOF W !,?80-$L("Wait List Stat Report")\2,"Wait List Stat Report",!
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRP4.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLRP4.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRP4.m	(revision 636)
@@ -1,4 +1,21 @@
 SDWLRP4 ;IOFO BAY PINES/TEH - WAITING LIST - MERGE RPC;06/28/2002 ; 26 Aug 2002  1:25 PM
- ;;5.3;scheduling;**263,485,497**;AUG 13 1993;Build 3
+ ;;5.3;scheduling;**263**;AUG 13 1993;Build 4
+ ;Modified from FOIA VISTA,
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  ;
 INPUT(SDWLRES,SDWLSTR) ;
@@ -83,32 +100,19 @@
  ;SDWLE=4 = UNDETERMINED
  ;
- S SDWLDE=+$H,SDWLE=0,(SDWLEE,SDWLRNED,SDWLDB)=0 D SB1
+ S SDWLDE=+$H,SDWLE=1,SDWLEE=0 D SB1
  G SB0:SDWLE=2
- S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) G SB0:$P(SDWLRNE,U,4)="A" S SDWLRNED=$P(SDWLRNE,U,3)
+ S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) S SDWLRNED=$P(SDWLRNE,U,3)
  I SDWLRNED S X=SDWLRNED D H^%DTC S SDWLDS=%H S SDWLDE=+$H,SDWLDET=SDWLDE-SDWLDS I SDWLDET<366 S SDWLE=1
  I $D(SDWLDET),SDWLDET>365 S SDWLE=3
  I 'SDWLRNE S SDWLE=4
-SB0 I $D(SDWLRNE),$P(SDWLRNE,U,4)="A" D
- .I 'SDWLEE.SDWLEE>730!(SDWLEE=730) S SDWLE=4 Q
- .I 'SDWLEE S SDWLE=4 Q
- S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"U",1:"U")
+SB0 S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"U")
  ;-Code here for filling in 409.3
  S DR="27////^S X=SDWLRNE",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
- S DR="27.1////^S X=$S($G(SDWLRNED):SDWLRNED,$G(SDWLD):SDWLD,1:"""")" D ^DIE
- S DR="27.2////^S X=SDWLDB" D ^DIE
  S DR="9////^S X=DUZ" D ^DIE K DIE,DA,DR,%H
- K SDWLRNE,SDWLD,SDWLDE,SDWLEE,SDWLDET,DIC,DIR,DR,DIE,SDWLDS,SDWLE,SDWLRNED
  Q
-SB1 I '$D(^DGCN(391.91,"B",SDWLDFN)) N SDWLDB S SDWLE=3 Q
+SB1 I '$D(^DGCN(391.91,"B",SDWLDFN)) S SDWLE=3 Q
  S SDWLX="" F  S SDWLX=$O(^DGCN(391.91,"B",SDWLDFN,SDWLX)) Q:SDWLX=""  D
- .S SDWLY=$G(^DGCN(391.91,SDWLX,0)) D
- ..;CHECK FOR TREATING FACILITY
- ..I $$TF^XUAF4(+$P(SDWLY,U,2)) D
- ...;SORT FOR LAST TREATMENT DATE
- ...S SDWLD=$P(SDWLY,U,3) I SDWLD S SDWLDTF(9999999-SDWLD)=SDWLX
- I '$D(SDWLDTF) Q
- S SDWLDTF=$O(SDWLDTF(0)) I SDWLDTF S (SDWLD,X)=9999999-SDWLDTF D H^%DTC S SDWLEE=SDWLDE-%H,SDWLDB=1 I SDWLEE<730 S SDWLE=2
- I $D(SDWLEE),SDWLEE>730 S SDWLE=3
- K SDWLDTF
+ .S SDWLY=$G(^DGCN(391.91,SDWLX,0)),SDWLD=$P(^(0),U,3) I SDWLD S X=SDWLD D H^%DTC S SDWLEE=SDWLDE-%H I SDWLEE<730 S SDWLE=2
+ .I $D(SDWLEE),SDWLEE>730 S SDWLE=3
  Q
 FDA ;Get data from SDWLSTR string and set FDA.
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRSR.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLRSR.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRSR.m	(revision 636)
@@ -1,4 +1,4 @@
-SDWLRSR ;BPOI/TEH - WAIT LIST STAT REPORT;10/01/02
- ;;5.3;scheduling;**263,273,399,412,425,415,524**;08/13/93;Build 29
+SDWLRSR ;;IOFO BAY PINES/TEH/WAIT LIST STAT REPORT ; 01 Oct 2002  4:42 PM  ; Compiled December 21, 2006 15:32:50
+ ;;5.3;scheduling;**263,273,399,412,425,415,446**;AUG 13 1993;Build 77
  ;
  ; Removed Sort logic as routine exceeded SACC maximum size of 10000
@@ -15,7 +15,6 @@
  I $D(DATE) S SDWLDATE=DATE
  I $D(INS) S SDWLINS=INS
- I $D(EXCL) S SDWLEXCL=EXCL
  I $D(ZTSAVE) D
- .S SDWLCT=$G(ZTSAVE("CT")),SDWLDATE=$G(ZTSAVE("DATE")),SDWLINS=$G(ZTSAVE("INS")),SDWLEXCL=$G(ZTSAVE("EXCL"))
+ .S SDWLCT=$G(ZTSAVE("CT")),SDWLDATE=$G(ZTSAVE("DATE")),SDWLINS=$G(ZTSAVE("INS"))
  I SDWLINS'="ALL" F I=1:1 S SDWL=$P(SDWLINS,";",I) Q:SDWL=""  S SDWL("INS",+SDWL)=""
  S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2),SDWLPG=0
@@ -24,61 +23,58 @@
  Q
 PRT ;PRINT REPORT
- S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,SDWLPG)=0 D HD,HD1 ;SD*5.3*415
+ S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13)=0  ;SD*5.3*446
+ S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13,SDWLPG)=0 D HD,HD1  ;SD*5.3*415,446
  I '$D(^TMP("SDWLRSR1")) W !!,"No Wait List Data to Report" Q
- S SDWLINS="" F  S SDWLINS=$O(^TMP("SDWLRSR1",$J,SDWLINS)) Q:SDWLINS=""  D  Q:POP  D T2  Q:POP  W !,"________________" I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412 added Quit for early exit
- .I $$S^%ZTLOAD S DUOUT="" Q
- .W !!,"INSTITUTION: ",SDWLINS,! K ^XTMP("SDWLRSR")
+ S SDWLINS="" F  S SDWLINS=$O(^TMP("SDWLRSR1",$J,SDWLINS)) Q:SDWLINS=""  D  Q:POP  D T2  Q:POP  W !,"________________" I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412 added Quit for early exit; 446
+ .I $$S^%ZTLOAD S DUOUT="" Q 
+ .W !!,"INSTITUTION: ",SDWLINS,!
  .S SDWLTY="" F  S SDWLTY=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY)) Q:SDWLTY=""  D  Q:POP  ;SD*5.3*412 added Quit for early exit
- ..S SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY)
+ ..S SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY) W !,$E(SDWLTNM,1,15)
  ..S SDWLSCN="" F  S SDWLSCN=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN)) Q:SDWLSCN=""  D  Q:POP  ;SD*5.3*412 added Quit for early exit
- ...S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 ;SD*5.3*415
  ...S SDWLSCNM="" F  S SDWLSCNM=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM)) Q:SDWLSCNM=""  D  Q:POP  D T1  Q:POP  ;SD*5.3*412 added Quit
  ....S SDWLPRI="" F  S SDWLPRI=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI)) Q:SDWLPRI=""  D  Q:POP  ;SD*5.3*412 added Quit
- .....S SDWLFLG=0
- .....S SDWLPR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR")) I SDWLEXCL,SDWLPR S SDWLFLG=1
- .....S SDWLCL=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL")) I 'SDWLFLG,SDWLEXCL,SDWLCL S SDWLFLG=1
- .....S SDWLD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD")) I 'SDWLFLG,SDWLEXCL,SDWLD S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLNC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC")) I 'SDWLFLG,SDWLEXCL,SDWLNC S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLSA=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA")) I 'SDWLFLG,SDWLEXCL,SDWLSA S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLCC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC")) I 'SDWLFLG,SDWLEXCL,SDWLCC S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLNN=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN")) I 'SDWLFLG,SDWLEXCL,SDWLNN S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLER=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER")) I 'SDWLFLG,SDWLEXCL,SDWLER S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLTR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR"))  I 'SDWLFLG,SDWLEXCL,SDWLTR S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLAD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD")) I 'SDWLFLG,SDWLEXCL,SDWLAD S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLRR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR")) I 'SDWLFLG,SDWLEXCL,SDWLRR S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLNR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR")) I 'SDWLFLG,SDWLEXCL,SDWLNR S SDWLFLG=1 ;W ?72,$J(SDWLNR,3)
- .....I 'SDWLEXCL,'SDWLFLG S SDWLFG=1
- .....I SDWLEXCL,'SDWLFLG Q
- .....I '$D(^XTMP("SDWLRSR",$J,SDWLTNM)) W !,$E(SDWLTNM,1,15) S ^XTMP("SDWLRSR",$J,SDWLTNM)=""
- .....W !?2,$E(SDWLSCNM_" "_$S(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:""),1,17)
- .....S T1=T1+SDWLPR,TT1=TT1+SDWLPR W ?21,$J(SDWLPR,3)
- .....S T2=T2+SDWLCL,TT2=TT2+SDWLCL W ?26,$J(SDWLCL,3)
- .....S T3=T3+SDWLD,TT3=TT3+SDWLD W ?31,$J(SDWLD,3)
- .....S T4=T4+SDWLNC,TT4=TT4+SDWLNC W ?36,$J(SDWLNC,3)
- .....S T5=T5+SDWLSA,TT5=TT5+SDWLSA W ?41,$J(SDWLSA,3)
- .....S T6=T6+SDWLCC,TT6=TT6+SDWLCC W ?46,$J(SDWLCC,3)
- .....S T7=T7+SDWLNN,TT7=TT7+SDWLNN W ?51,$J(SDWLNN,3)
- .....S T8=T8+SDWLER,TT8=TT8+SDWLER W ?56,$J(SDWLER,3)
- .....S T9=T9+SDWLTR,TT9=TT9+SDWLTR W ?61,$J(SDWLTR,3) ;SD*5.3*415
- .....S T10=T10+SDWLAD,TT10=TT10+SDWLAD W ?66,$J(SDWLAD,3) ;SD*5.3*415
- .....S T11=T11+SDWLRR,TT11=TT11+SDWLRR W ?71,$J(SDWLRR,3) ;SD*5.3*415
- .....S T12=T12+SDWLNR,TT12=TT12+SDWLNR W ?76,$J(SDWLNR,3) ;SD*5.3*415
- .....I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412
+ .....N SDWLCLO  ; SD*5.3*446
+ .....W !,?2,$E(SDWLSCNM,1,10)," ",$S(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:"")
+ .....S SDWLPR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR")) W ?20,SDWLPR
+ .....S SDWLCLO=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL")) W ?27,SDWLCLO  ;SD*5.3*446
+ .....S SDWLD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD")) W ?34,SDWLD  ;SD*5.3*415,446
+ .....S SDWLNC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC")) W ?41,SDWLNC  ;SD*5.3*415,446
+ .....S SDWLSA=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA")) W ?48,SDWLSA  ;SD*5.3*415,446
+ .....S SDWLCC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC")) W ?55,SDWLCC  ;SD*5.3*415,446
+ .....S SDWLNN=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN")) W ?62,SDWLNN  ;SD*5.3*415,446
+ .....S SDWLER=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER")) W ?69,SDWLER  ;SD*5.3*415,446
+ .....S SDWLCL=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCL")) W ?76,SDWLCL  ;SD*5.3*415,446
+ .....S SDWLTR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR")) W ?83,SDWLTR  ;SD*5.3*415,446
+ .....S SDWLAD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD")) W ?90,SDWLAD  ;SD*5.3*415,446
+ .....S SDWLRR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR")) W ?97,SDWLRR  ;SD*5.3*415,446
+ .....S SDWLNR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR")) W ?104,SDWLNR  ;SD*5.3*446
+ .....S T1=T1+SDWLPR,TT1=TT1+SDWLPR
+ .....S T2=T2+SDWLCLO,TT2=TT2+SDWLCLO  ;SD*5.3*446
+ .....S T3=T3+SDWLD,TT3=TT3+SDWLD
+ .....S T4=T4+SDWLNC,TT4=TT4+SDWLNC
+ .....S T5=T5+SDWLSA,TT5=TT5+SDWLSA
+ .....S T6=T6+SDWLCC,TT6=TT6+SDWLCC
+ .....S T7=T7+SDWLNN,TT7=TT7+SDWLNN
+ .....S T8=T8+SDWLER,TT8=TT8+SDWLER
+ .....S T9=T9+SDWLCL,TT9=TT9+SDWLCL  ;SD*5.3*446
+ .....S T10=T10+SDWLTR,TT10=TT10+SDWLTR  ;SD*5.3*446
+ .....S T11=T11+SDWLAD,TT11=TT11+SDWLAD  ;SD*5.3*446
+ .....S T12=T12+SDWLRR,TT12=TT12+SDWLRR  ;SD*5.3*446
+ .....S T13=T13+SDWLNR,TT13=TT13+SDWLNR  ;SD*5.3*446
+ .....I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412,446
  Q
 SCR S DIR(0)="E" D ^DIR S:X="^" POP=1  ;SD*5.3*412
  Q
 T1 ;
- I 'SDWLFLG,SDWLEXCL Q
- W !?20,"---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----"  ;SD*5.3*415
- W !,"Sub-Totals:"
  ;write sub-totals
- W ?21,$J(T1,3),?26,$J(T2,3),?31,$J(T3,3),?36,$J(T4,3),?41,$J(T5,3),?46,$J(T6,3),?51,$J(T7,3),?56,$J(T8,3),?61,$J(T9,3),?66,$J(T10,3),?71,$J(T11,3),?76,$J(T12,3),!  ;SD*5.3*415
- S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0  ;SD*5.3*415
- I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412
+ W !?20,"------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------"  ;SD*5.3*446
+ W !,"Sub-Totals:",?20,T1,?27,T2,?34,T3,?41,T4,?48,T5,?55,T6,?62,T7,?69,T8,?76,T9,?83,T10,?90,T11,?97,T12,?104,T13  ;SD*5.3*446
+ S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13)=0  ;SD*5.3*415,446
+ I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412,446
  Q
 T2 W !,"Institution Totals:"
- W ?21,$J(TT1,3),?26,$J(TT2,3),?31,$J(TT3,3),?36,$J(TT4,3),?41,$J(TT5,3),?46,$J(TT6,3),?51,$J(TT7,3),?56,$J(TT8,3),?61,$J(TT9,3),?66,$J(TT10,3),?71,$J(TT11,3),?76,$J(TT12,3),!  ;SD*5.3*415
- S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12)=0  ;SD*5.3*415
- I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412
+ W ?20,TT1,?27,TT2,?34,TT3,?41,TT4,?48,TT5,?55,TT6,?62,TT7,?69,TT8,?76,TT9,?83,TT10,?90,TT11,?97,TT12,?104,TT13,!  ;SD*5.3*446
+ S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13)=0  ;SD*5.3*415,446
+ I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP  D HD,HD1  ;SD*5.3*412,446
  Q
 HD W:$D(IOF) @IOF S SDWLPG=SDWLPG+1 W !!,SDWLDTP,?80-$L("Wait List (Sch/PCMM) Stat Report")\2,"Wait List (Sch/PCMM) Stat Report",?65,"Page: ",SDWLPG
@@ -87,14 +83,11 @@
  Q
 HD1 ;
- W !,?20,"PREV"
- W ?65,"#"
- W ?75,"# NOT"
- W !,"WAIT LIST TYPE"
- W ?20,"REMN",?25,"CLSD",?31,"DTH",?37,"NC",?42,"SA",?47,"CC",?52,"NN",?57,"ER",?61,"TR",?65,"ADD",?70,"REMN",?75,"REMVD",!  ;SD*5.3*415
+ W !,?20,"PREV",?90,"#",?97,"#",?104,"# NOT"  ;SD*5.3*415,446
+ W !,"WAIT LIST TYPE",?20,"REMN",?27,"CLSD",?34,"DTH",?41,"NC",?48,"SA",?55,"CC",?62,"NN",?69,"ER",?76,"CL",?83,"TR",?90,"ADD",?97,"REMN",?104,"REMVD"  ;SD*5.3*446
  Q
 END D EN^SDWLKIL
  K ^TMP("SDWLRSR1",$J),^TMP("SDWLRSR2",$J),SDWLY1,SDWLX1,SDWLRDT,CT,I
- K T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,SDWLAD,SDWLBD,SDWLCC,SDWLCT,SDWLDFDT,SDWLDP,SDWLED,SDWLER,SDWLERR,SDWLFLD,X1,X2,DATE  ;SD*5.3*415
- K TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,SDWLINSN,SDWLINST,SDWLNC,SDWLNN,SDWLNR,SDWLOFDT,SDWLOK1,SDWLOK2,SDWLTYPN  ;SD*5.3*415
- K SDWLOK3,SDWLPR,SDWLPR,SDWLPROM,SDWLRE,SDWLRFDT,SDWLRR,SDWLSA,SDWLSCN,SDWLSCNM,SDWLTASK,SDWLTK,SDWLTNM,SDWLTYNM,SDWLTYP,X4,SDWLTR  ;SD*5.3*415
+ K T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13,SDWLAD,SDWLBD,SDWLCC,SDWLCT,SDWLDFDT,SDWLDP,SDWLED,SDWLER,SDWLERR,SDWLFLD,X1,X2,DATE  ;SD*5.3*415,446
+ K TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13,SDWLINSN,SDWLINST,SDWLNC,SDWLNN,SDWLNR,SDWLOFDT,SDWLOK1,SDWLOK2,SDWLTYPN  ;SD*5.3*415,446
+ K SDWLOK3,SDWLPR,SDWLPR,SDWLPROM,SDWLRE,SDWLRFDT,SDWLRR,SDWLSA,SDWLSCN,SDWLSCNM,SDWLTASK,SDWLTK,SDWLTNM,SDWLTYNM,SDWLTYP,X4,SDWLTR,SDWLCL  ;SD*5.3*415,446
  Q
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXA.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDXA.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXA.m	(revision 636)
@@ -1,3 +1,3 @@
-SDXA ; GENERATED FROM 'SDAMBT' INPUT TEMPLATE(#491), FILE 409.5;05/28/97
+SDXA ; GENERATED FROM 'SDAMBT' INPUT TEMPLATE(#491), FILE 409.5;12/25/06
  D DE G BEGIN
 DE S DIE="^SDV(",DIC=DIE,DP=409.5,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^SDV(DA,""))=""
@@ -14,5 +14,5 @@
 B G @DQ
 RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G A:DV'["R",X:'DV,X:D'>0,A
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
 RD G QS:X?."?" I X["^" D D G ^DIE17
  I X="@" D D G Z^DIE2
@@ -20,9 +20,9 @@
 T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
  K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
  G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
  I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
 V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
  S X="?BAD"
@@ -42,8 +42,16 @@
  D ^DIR I 'DDER S %=Y(0),X=Y
  Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="SDXA",DQ=1
- S:$D(DTIME)[0 DTIME=300 S D0=DA,DIEZ=491,U="^"
+ N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBADK S DIEZTMP=$$GETTMP^DIKC1("DIEZ")
+ M DIEZAR=^DIE(491,"AR") S DICRREC="TRIG^DIE17"
+ S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_",",DIEZ=491,U="^"
 1 S D=0 K DE(1) ;10
- S DIFLD=10,DGO="^SDXA1",DC="14^409.51P^CS^",DV="409.51P40.7'",DW="0;1",DOW="CLINIC STOP CODE",DLB="Select "_DOW S:D DC=DC_D
+ S DIFLD=10,DGO="^SDXA1",DC="15^409.51P^CS^",DV="409.51P40.7'",DW="0;1",DOW="CLINIC STOP CODE",DLB="Select "_DOW S:D DC=DC_D
  S DU="DIC(40.7,"
  I $D(DSC(409.51))#2,$P(DSC(409.51),"I $D(^UTILITY(",1)="" X DSC(409.51) S D=$O(^(0)) S:D="" D=-1 G M1
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXA1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDXA1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXA1.m	(revision 636)
@@ -1,6 +1,7 @@
-SDXA1 ; ;05/28/97
+SDXA1 ; ;12/25/06
  D DE G BEGIN
 DE S DIE="^SDV(D0,""CS"",",DIC=DIE,DP=409.51,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SDV(D0,"CS",DA,""))=""
  I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,3) S:%]"" DE(2)=% S %=$P(%Z,U,4) S:%]"" DE(3)=% S %=$P(%Z,U,5) S:%]"" DE(4)=% S %=$P(%Z,U,7) S:%]"" DE(5)=%
+ I $D(^("PR")) S %Z=^("PR") S %=$P(%Z,U,1) S:%]"" DE(6)=% S %=$P(%Z,U,2) S:%]"" DE(7)=% S %=$P(%Z,U,3) S:%]"" DE(8)=% S %=$P(%Z,U,4) S:%]"" DE(9)=% S %=$P(%Z,U,5) S:%]"" DE(10)=%
  K %Z Q
  ;
@@ -15,5 +16,5 @@
 B G @DQ
 RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G A:DV'["R",X:'DV,X:D'>0,A
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
 RD G QS:X?."?" I X["^" D D G ^DIE17
  I X="@" D D G Z^DIE2
@@ -21,9 +22,9 @@
 T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
  K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
  G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
  I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
 V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
  S X="?BAD"
@@ -43,4 +44,10 @@
  D ^DIR I 'DDER S %=Y(0),X=Y
  Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="SDXA1",DQ=1
 1 S DW="0;2",DV="P200'",DU="",DLB="EDITED LAST BY",DIFLD=2
@@ -48,5 +55,5 @@
  S X=$S($D(DUZ):DUZ,1:"")
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
 X1 Q
@@ -55,5 +62,5 @@
  S X=$S($D(SDCL):SDCL,1:"")
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
 X2 Q
@@ -63,11 +70,13 @@
  S X=$S(+SDEMP:+SDEMP,'+VAEL(1):"",1:+VAEL(1))
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
-C3 G C3S:$D(DE(3))[0 K DB S X=DE(3),DIC=DIE
+C3 G C3S:$D(DE(3))[0 K DB
+ S X=DE(3),DIC=DIE
  ;
-C3S S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+ S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA X ^DD(409.51,4,1,1,89.2) S Y(101)=$S($D(^SCE(D0,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(101),U,13),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=X X ^DD(409.51,4,1,1,1.4)
- Q
+C3F1 Q
 X3 Q
 4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW="0;5",DV="R*P409.1'",DU="",DLB="APPOINTMENT TYPE",DIFLD=5
@@ -76,7 +85,8 @@
  S X=SDAPTYP
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
-C4 G C4S:$D(DE(4))[0 K DB S X=DE(4),DIC=DIE
+C4 G C4S:$D(DE(4))[0 K DB
+ S X=DE(4),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(0)=X S X="369"'[X I X S X=DIV S Y(1)=$S($D(^SDV(D0,"CS",D1,0)):^(0),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(409.51,5,1,1,2.4)
  S X=DE(4),DIC=DIE
@@ -86,5 +96,6 @@
  S X=DE(4),DIC=DIE
  ;
-C4S S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
+C4S S X="" G:DG(DQ)=X C4F1 K DB
+ S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(0)=X S X="369"'[X I X S X=DIV S Y(1)=$S($D(^SDV(D0,"CS",D1,0)):^(0),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(409.51,5,1,1,1.1) X ^DD(409.51,5,1,1,1.4)
  S X=DG(DQ),DIC=DIE
@@ -94,11 +105,46 @@
  S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA X ^DD(409.51,5,1,4,89.2) S Y(101)=$S($D(^SCE(D0,0)):^(0),1:"") S X=$S('$D(^SD(409.1,+$P(Y(101),U,10),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=X X ^DD(409.51,5,1,4,1.4)
- Q
+C4F1 Q
 X4 Q
 5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW="0;7",DV="D",DU="",DLB="DATE ENTRY MADE",DIFLD=7
  S X=DT
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
 X5 Q
-6 D:$D(DG)>9 F^DIE17 G ^SDXA2
+6 S DW="PR;1",DV="*P81'X",DU="",DLB="PROCEDURE 1",DIFLD=21
+ S DU="ICPT("
+ S X=$S($D(SDNEW(1)):SDNEW(1),1:"")
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X6 Q
+7 S DW="PR;2",DV="*P81'X",DU="",DLB="PROCEDURE 2",DIFLD=22
+ S DU="ICPT("
+ S X=$S($D(SDNEW(2)):SDNEW(2),1:"")
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X7 Q
+8 S DW="PR;3",DV="*P81'X",DU="",DLB="PROCEDURE 3",DIFLD=23
+ S DU="ICPT("
+ S X=$S($D(SDNEW(3)):SDNEW(3),1:"")
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X8 Q
+9 S DW="PR;4",DV="*P81'X",DU="",DLB="PROCEDURE 4",DIFLD=24
+ S DU="ICPT("
+ S X=$S($D(SDNEW(4)):SDNEW(4),1:"")
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X9 Q
+10 S DW="PR;5",DV="*P81'X",DU="",DLB="PROCEDURE 5",DIFLD=25
+ S DU="ICPT("
+ S X=$S($D(SDNEW(5)):SDNEW(5),1:"")
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X10 Q
+11 G 1^DIE17
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDXACSE.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE.m	(revision 636)
@@ -1,3 +1,3 @@
-SDXACSE ; GENERATED FROM 'SDXACSE' INPUT TEMPLATE(#490), FILE 409.5;05/28/97
+SDXACSE ; GENERATED FROM 'SDXACSE' INPUT TEMPLATE(#490), FILE 409.5;12/25/06
  D DE G BEGIN
 DE S DIE="^SDV(",DIC=DIE,DP=409.5,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^SDV(DA,""))=""
@@ -14,5 +14,5 @@
 B G @DQ
 RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G A:DV'["R",X:'DV,X:D'>0,A
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
 RD G QS:X?."?" I X["^" D D G ^DIE17
  I X="@" D D G Z^DIE2
@@ -20,9 +20,9 @@
 T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
  K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
  G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
  I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
 V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
  S X="?BAD"
@@ -42,14 +42,22 @@
  D ^DIR I 'DDER S %=Y(0),X=Y
  Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="SDXACSE",DQ=1
- S:$D(DTIME)[0 DTIME=300 S D0=DA,DIEZ=490,U="^"
-1 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=1 D X1 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+ N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBADK S DIEZTMP=$$GETTMP^DIKC1("DIEZ")
+ M DIEZAR=^DIE(490,"AR") S DICRREC="TRIG^DIE17"
+ S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_",",DIEZ=490,U="^"
+1 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=1 D X1 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
 X1 I '$D(SDAPTYP)!('$D(SDAPTYPR))!('$D(SDCPT))!('$D(SDJ)) W !,*7,"Variables must be defined, edit using option." S Y="@89"
  Q
-2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
 X2 I '$S($D(SDUZ):1,$D(DUZ):1,1:0) W !,*7,"User not defined." S Y="@89"
  Q
 3 S D=0 K DE(1) ;10
- S DIFLD=10,DGO="^SDXACSE1",DC="14^409.51P^CS^",DV="409.51P40.7'",DW="0;1",DOW="CLINIC STOP CODE",DLB="Select "_DOW S:D DC=DC_D
+ S DIFLD=10,DGO="^SDXACSE1",DC="15^409.51P^CS^",DV="409.51P40.7'",DW="0;1",DOW="CLINIC STOP CODE",DLB="Select "_DOW S:D DC=DC_D
  S DU="DIC(40.7,"
  I $D(DSC(409.51))#2,$P(DSC(409.51),"I $D(^UTILITY(",1)="" X DSC(409.51) S D=$O(^(0)) S:D="" D=-1 G M3
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE1.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDXACSE1.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE1.m	(revision 636)
@@ -1,6 +1,8 @@
-SDXACSE1 ; ;05/28/97
+SDXACSE1 ; ;12/25/06
  D DE G BEGIN
 DE S DIE="^SDV(D0,""CS"",",DIC=DIE,DP=409.51,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SDV(D0,"CS",DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,3) S:%]"" DE(2)=% S %=$P(%Z,U,4) S:%]"" DE(3)=% S %=$P(%Z,U,5) S:%]"" DE(4)=%
+ I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,3) S:%]"" DE(2)=% S %=$P(%Z,U,4) S:%]"" DE(3)=% S %=$P(%Z,U,5) S:%]"" DE(4)=% S %=$P(%Z,U,6) S:%]"" DE(8)=%
+ I $D(^(1)) S %Z=^(1) S %=$P(%Z,U,1) S:%]"" DE(6)=%
+ I $D(^("PR")) S %Z=^("PR") S %=$P(%Z,U,1) S:%]"" DE(10)=% S %=$P(%Z,U,2) S:%]"" DE(12)=% S %=$P(%Z,U,3) S:%]"" DE(14)=% S %=$P(%Z,U,4) S:%]"" DE(16)=%
  K %Z Q
  ;
@@ -15,5 +17,5 @@
 B G @DQ
 RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G A:DV'["R",X:'DV,X:D'>0,A
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
 RD G QS:X?."?" I X["^" D D G ^DIE17
  I X="@" D D G Z^DIE2
@@ -21,9 +23,9 @@
 T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
  K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
  G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
  I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
 V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
  S X="?BAD"
@@ -43,4 +45,10 @@
  D ^DIR I 'DDER S %=Y(0),X=Y
  Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="SDXACSE1",DQ=1
 1 S DW="0;2",DV="P200'",DU="",DLB="EDITED LAST BY",DIFLD=2
@@ -48,5 +56,5 @@
  S X=$S($D(SDUZ):SDUZ,1:DUZ)
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
 X1 Q
@@ -55,5 +63,5 @@
  S X=$P(SDCPT(SDJ),U,2)
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
 X2 Q
@@ -63,11 +71,13 @@
  S X=$S($G(SDOEP):$P($G(^SCE(SDOEP,0)),U,13),1:"")
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
-C3 G C3S:$D(DE(3))[0 K DB S X=DE(3),DIC=DIE
+C3 G C3S:$D(DE(3))[0 K DB
+ S X=DE(3),DIC=DIE
  ;
-C3S S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+ S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA X ^DD(409.51,4,1,1,89.2) S Y(101)=$S($D(^SCE(D0,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(101),U,13),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=X X ^DD(409.51,4,1,1,1.4)
- Q
+C3F1 Q
 X3 Q
 4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW="0;5",DV="R*P409.1'",DU="",DLB="APPOINTMENT TYPE",DIFLD=5
@@ -76,7 +86,8 @@
  S X=SDAPTYP
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
-C4 G C4S:$D(DE(4))[0 K DB S X=DE(4),DIC=DIE
+C4 G C4S:$D(DE(4))[0 K DB
+ S X=DE(4),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(0)=X S X="369"'[X I X S X=DIV S Y(1)=$S($D(^SDV(D0,"CS",D1,0)):^(0),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(409.51,5,1,1,2.4)
  S X=DE(4),DIC=DIE
@@ -86,5 +97,6 @@
  S X=DE(4),DIC=DIE
  ;
-C4S S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
+C4S S X="" G:DG(DQ)=X C4F1 K DB
+ S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(0)=X S X="369"'[X I X S X=DIV S Y(1)=$S($D(^SDV(D0,"CS",D1,0)):^(0),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(409.51,5,1,1,1.1) X ^DD(409.51,5,1,1,1.4)
  S X=DG(DQ),DIC=DIE
@@ -94,8 +106,74 @@
  S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA X ^DD(409.51,5,1,4,89.2) S Y(101)=$S($D(^SCE(D0,0)):^(0),1:"") S X=$S('$D(^SD(409.1,+$P(Y(101),U,10),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=X X ^DD(409.51,5,1,4,1.4)
- Q
+C4F1 Q
 X4 Q
-5 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 D X5 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+5 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 D X5 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
 X5 I $D(SDNOTCG) S Y="@1"
  Q
-6 D:$D(DG)>9 F^DIE17 G ^SDXACSE2
+6 D:$D(DG)>9 F^DIE17,DE S DQ=6,DW="1;1",DV="SI",DU="",DLB="COMPUTER GENERATED?",DIFLD=11
+ S DE(DW)="C6^SDXACSE1"
+ S DU="1:YES;"
+ S X=1
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+C6 G C6S:$D(DE(6))[0 K DB
+ S X=DE(6),DIC=DIE
+ K:X ^SDV("AG",DA(1),DA)
+C6S S X="" G:DG(DQ)=X C6F1 K DB
+ S X=DG(DQ),DIC=DIE
+ S:X ^SDV("AG",DA(1),DA)=""
+C6F1 Q
+X6 Q
+7 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=7 D X7 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X7 I 'SDAPTYPR S Y="@1"
+ Q
+8 D:$D(DG)>9 F^DIE17,DE S DQ=8,DW="0;6",DV="S",DU="",DLB="UNRESOLVED APPT TYPE REASON",DIFLD=6
+ S DU="1:DUAL ELIGIBILITY;2:POSSIBLE COMP & PEN;"
+ S X=SDAPTYPR
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X8 Q
+9 S DQ=10 ;@1
+10 S DW="PR;1",DV="*P81'X",DU="",DLB="PROCEDURE 1",DIFLD=21
+ S DU="ICPT("
+ S X=$P(SDCPT(SDJ),U,3)
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X10 Q
+11 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 D X11 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X11 I $P(SDCPT(SDJ),U,4)']"" S Y="@99"
+ Q
+12 S DW="PR;2",DV="*P81'X",DU="",DLB="PROCEDURE 2",DIFLD=22
+ S DU="ICPT("
+ S X=$P(SDCPT(SDJ),U,4)
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X12 Q
+13 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=13 D X13 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X13 I $P(SDCPT(SDJ),U,5)']"" S Y="@99"
+ Q
+14 S DW="PR;3",DV="*P81'X",DU="",DLB="PROCEDURE 3",DIFLD=23
+ S DU="ICPT("
+ S X=$P(SDCPT(SDJ),U,5)
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X14 Q
+15 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=15 D X15 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X15 I $P(SDCPT(SDJ),U,6)']"" S Y="@99"
+ Q
+16 S DW="PR;4",DV="*P81'X",DU="",DLB="PROCEDURE 4",DIFLD=24
+ S DU="ICPT("
+ S X=$P(SDCPT(SDJ),U,6)
+ S Y=X
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD:X="@",Z
+X16 Q
+17 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=17 D X17 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X17 I $P(SDCPT(SDJ),U,7)']"" S Y="@99"
+ Q
+18 D:$D(DG)>9 F^DIE17 G ^SDXACSE2
Index: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE2.m
===================================================================
--- FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDXACSE2.m	(revision 631)
+++ FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE2.m	(revision 636)
@@ -1,8 +1,6 @@
-SDXACSE2 ; ;05/28/97
+SDXACSE2 ; ;12/25/06
  D DE G BEGIN
 DE S DIE="^SDV(D0,""CS"",",DIC=DIE,DP=409.51,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SDV(D0,"CS",DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,6) S:%]"" DE(3)=%
- I $D(^(1)) S %Z=^(1) S %=$P(%Z,U,1) S:%]"" DE(1)=%
- I $D(^("PR")) S %Z=^("PR") S %=$P(%Z,U,1) S:%]"" DE(5)=% S %=$P(%Z,U,2) S:%]"" DE(7)=% S %=$P(%Z,U,3) S:%]"" DE(9)=% S %=$P(%Z,U,4) S:%]"" DE(11)=% S %=$P(%Z,U,5) S:%]"" DE(13)=%
+ I $D(^("PR")) S %Z=^("PR") S %=$P(%Z,U,5) S:%]"" DE(1)=%
  K %Z Q
  ;
@@ -17,5 +15,5 @@
 B G @DQ
 RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G A:DV'["R",X:'DV,X:D'>0,A
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
 RD G QS:X?."?" I X["^" D D G ^DIE17
  I X="@" D D G Z^DIE2
@@ -23,9 +21,9 @@
 T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
  K DDER G X
-P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0
+P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
  G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
  I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
 V D @("X"_DQ) K YS
-Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
+Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
  S X="?BAD"
@@ -45,76 +43,18 @@
  D ^DIR I 'DDER S %=Y(0),X=Y
  Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="SDXACSE2",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="1;1",DV="SI",DU="",DLB="COMPUTER GENERATED?",DIFLD=11
- S DE(DW)="C1^SDXACSE2"
- S DU="1:YES;"
- S X=1
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD:X="@",Z
-C1 G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE
- K:X ^SDV("AG",DA(1),DA)
-C1S S X="" Q:DG(DQ)=X  K DB S X=DG(DQ),DIC=DIE
- S:X ^SDV("AG",DA(1),DA)=""
- Q
-X1 Q
-2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X2 I 'SDAPTYPR S Y="@1"
- Q
-3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW="0;6",DV="S",DU="",DLB="UNRESOLVED APPT TYPE REASON",DIFLD=6
- S DU="1:DUAL ELIGIBILITY;2:POSSIBLE COMP & PEN;"
- S X=SDAPTYPR
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD:X="@",Z
-X3 Q
-4 S DQ=5 ;@1
-5 S DW="PR;1",DV="*P81'X",DU="",DLB="PROCEDURE 1",DIFLD=21
- S DU="ICPT("
- S X=$P(SDCPT(SDJ),U,3)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD:X="@",Z
-X5 Q
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X6 I $P(SDCPT(SDJ),U,4)']"" S Y="@99"
- Q
-7 S DW="PR;2",DV="*P81'X",DU="",DLB="PROCEDURE 2",DIFLD=22
- S DU="ICPT("
- S X=$P(SDCPT(SDJ),U,4)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD:X="@",Z
-X7 Q
-8 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X8 I $P(SDCPT(SDJ),U,5)']"" S Y="@99"
- Q
-9 S DW="PR;3",DV="*P81'X",DU="",DLB="PROCEDURE 3",DIFLD=23
- S DU="ICPT("
- S X=$P(SDCPT(SDJ),U,5)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD:X="@",Z
-X9 Q
-10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X10 I $P(SDCPT(SDJ),U,6)']"" S Y="@99"
- Q
-11 S DW="PR;4",DV="*P81'X",DU="",DLB="PROCEDURE 4",DIFLD=24
- S DU="ICPT("
- S X=$P(SDCPT(SDJ),U,6)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD:X="@",Z
-X11 Q
-12 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=12 D X12 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X12 I $P(SDCPT(SDJ),U,7)']"" S Y="@99"
- Q
-13 S DW="PR;5",DV="*P81'X",DU="",DLB="PROCEDURE 5",DIFLD=25
+1 S DW="PR;5",DV="*P81'X",DU="",DLB="PROCEDURE 5",DIFLD=25
  S DU="ICPT("
  S X=$P(SDCPT(SDJ),U,7)
  S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
  G RD:X="@",Z
-X13 Q
-14 S DQ=15 ;@99
-15 G 1^DIE17
+X1 Q
+2 S DQ=3 ;@99
+3 G 1^DIE17
