SDCLAV0 ;ALB/LDB - OUTPUT PATTERNS (cont.) ; 05 Mar 99 11:31 AM
;;5.3;PIMS;**184,439,490,517,529,1015,1016**;JUN 30, 2012;Build 20
;IHS/ANMC/LJF 10/05/2000 changed SSN to chart #
; screened out principal clinics and those
; with no appt patterns
; added call to view in browse mode
;
;SD/517 CHANGED FOR LOOPS
I $E(IOST,1,2)="C-" D EN^BSDCLAV Q ;IHS/ANMC/LJF 10/5/2000 list mgr
IHS ;EP; -- re-entry after calling listman codE;IHS/ANMC/LJF 10/5/2000
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
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,"^")
I $D(^SC("AIHSPC",SDC)) Q ;IHS/ANMC/LJF 10/5/2000 principal clinic
I '$O(^SC(SDC,"ST",0)) Q ;IHS/ANMC/LJF 10/5/2000 no pattern
S $P(^UTILITY($J,"SDNMS",D,SDNM),"^",3)=SDC
Q
NM ;called by SDCLAV1 - SD/517 CHANGED FOR LOOP
S SDAP1=0 F S SDAP1=$O(^SC(SDC,"S",SDAP,1,SDAP1)) Q:'SDAP1 D NM1
K M1,SDN1,SDN2,SDN3,SDC3,SDAP1 ; SD*5.3*439 added Kill of local vars
Q
NM1 I '$D(^SC(SDC,"S",SDAP,1,SDAP1,0)) N POP S POP=0,(SDN1,SDN2,SDN3)="" D CHECK,KILL Q ;added SD/517
I $P(^SC(SDC,"S",SDAP,1,SDAP1,0),U,1)="" D SETUTL Q ;SD*509
;S SDN1=+^SC(SDC,"S",SDAP,1,SDAP1,0),M1=$P(^(0),"^",2),SDC3=$P(^(0),"^",9),SDN2=$P(^DPT(+SDN1,0),"^"),SDN3=$P(^(0),"^",9),SDN3=$S(SDN3="":"UNKNOWN",1:SDN3) I $D(SDCI) D NM2 Q
S SDN1=+^SC(SDC,"S",SDAP,1,SDAP1,0),M1=$P(^(0),"^",2),SDC3=$P(^(0),"^",9),SDN2=$P(^DPT(+SDN1,0),"^"),SDN3=$P(^(0),"^",9),SDN3=$$HRCN^BDGF2(+SDN1,+$$FAC^BSDU(SDC)),SDN3=$S(SDN3="":"UNKNOWN",1:SDN3) I $D(SDCI) D NM2 Q ;IHS/ANMC/LJF 10/5/2000
; SD*5.3*439 added quit if clinic in "S" node not = to selected clinic
I '$D(SDCI),$D(^DPT(SDN1,"S",SDAP,0)),$P(^(0),"^",2)'["C",$P(^(0),"^",2)'="N",$P(^(0),"^",2)'="NA" Q:$P(^(0),U,1)'=SDC D NM2 Q
Q
;SD*5.3*490 do not display appts prior to clinic start date
NM2 Q:$P(SDAP,".",1)<$O(^SC(SDC,"T",0)) ;SD*5.3*490
S:$D(^DPT(SDN1,"S",SDAP,0)) ^UTILITY($J,"SDNMS",D,SDV,SDAP,SDN2,SDN3)=M1_$S(($P(^DPT(SDN1,"S",SDAP,0),"^",2)["C"):"^*",SDC3="C":"^*",($P(^(0),"^",2)="N"):"^**",($P(^(0),"^",2)="NA"):"^**",1:"")
S:$D(^DPT(SDN1,"S",SDAP,0)) $P(^UTILITY($J,"SDNMS",D,SDV,SDAP,SDN2,SDN3),"^",3)=$S($P(^DPT(SDN1,"S",SDAP,0),"^",7)=4:"***",1:"")
Q
;
CHECK ;Added SD/517
N SDIEN,NODE,NODE0,HDFN,HDNAM,HDSN,POP
S SDIEN=0,NODE="",HDAP1=SDAP1
F S SDIEN=$O(^SCE("B",SDAP,SDIEN)) Q:'SDIEN D
.S NODE=^SCE(SDIEN,0)
.Q:$P(NODE,U,4)'=SDC
.S HDFN=$P(NODE,U,2),HDNAM=$P(^DPT(HDFN,0),U),HDSN=$P(^(0),U,9)
.Q:$D(^UTILITY($J,"SDNMS",D,SDV,SDAP,HDNAM,HDSN))
.S POP=0 D CHECK1 Q:POP
.S SDN1=$P(NODE,U,2),SDN2=$P(^DPT(SDN1,0),U),SDN3=$P(^DPT(SDN1,0),U,9),M1="",SDC3=""
.D NM2
Q
;
CHECK1 ;Added SD/517
S HDAP1=$O(^SC(SDC,"S",SDAP,1,HDAP1)) Q:'HDAP1
Q:'$D(^SC(SDC,"S",SDAP,1,HDAP1,0)) S NODE0=^(0)
I $P(NODE0,U,1)=HDFN S POP=1 Q
Q
;
KILL K SDIEN,NODE,NODE0,POP,HDFN,HDNAM,HDSN,HDAP1 ;added SD/517
Q
;
SETUTL ;SD*509 set Utility for null DFN, corrupt node will be deleted in SDCLAV1
S (SDN1,SDN2,SDN3)="UNKNOWN",M1=0
S ^UTILITY($J,"SDNMS",D,SDV,SDAP,SDN2,SDN3)=M1_"^"_SDC_"^"_SDAP1
Q
;
SDCLAV0 ;ALB/LDB - OUTPUT PATTERNS (cont.) ; 05 Mar 99 11:31 AM
+1 ;;5.3;PIMS;**184,439,490,517,529,1015,1016**;JUN 30, 2012;Build 20
+2 ;IHS/ANMC/LJF 10/05/2000 changed SSN to chart #
+3 ; screened out principal clinics and those
+4 ; with no appt patterns
+5 ; added call to view in browse mode
+6 ;
+7 ;SD/517 CHANGED FOR LOOPS
+8 ;IHS/ANMC/LJF 10/5/2000 list mgr
IF $EXTRACT(IOST,1,2)="C-"
DO EN^BSDCLAV
QUIT
IHS ;EP; -- re-entry after calling listman codE;IHS/ANMC/LJF 10/5/2000
+1 IF 'VAUTC
SET SDC=0
FOR
SET SDC=$ORDER(VAUTC(SDC))
IF 'SDC
QUIT
SET SDV=VAUTC(SDC)
IF VAUTD!($DATA(VAUTD(+$PIECE(^SC(SDC,0),"^",15))))!('$PIECE(^(0),"^",15)&$DATA(VAUTD($PIECE(^DG(43,1,"GL"),"^",3))))
DO S1
+2 IF VAUTC
SET SDC=0
FOR
SET SDC=$ORDER(^SC(SDC))
IF 'SDC
QUIT
IF $PIECE(^(SDC,0),"^",3)="C"
IF VAUTD!($DATA(VAUTD(+$PIECE(^(0),"^",15))))!('$PIECE(^(0),"^",15)&$DATA(VAUTD($PIECE(^DG(43,1,"GL"),"^",3))))
DO S1
+3 IF $DATA(^UTILITY($JOB,"SDNMS"))
DO S2^SDCLAV1
+4 ;following line commented off per SD*529
+5 ;S DGTCH="CLINIC AVAILABILITY REPORT^CLINIC^PAGE#" D:$E(IOST,1,2)="P-" TP^DGUTL K SDBD,SDCI,SDED D END^SDCLAV Q
+6 DO END^SDCLAV
QUIT
S1 SET SD=^SC(SDC,0)
SET D=$SELECT($PIECE(SD,"^",15):$PIECE(SD,"^",15),1:$PIECE(^DG(43,1,"GL"),"^",3))
SET SD5=0
SET SDNM=$PIECE(SD,"^")
+1 ;IHS/ANMC/LJF 10/5/2000 principal clinic
IF $DATA(^SC("AIHSPC",SDC))
QUIT
+2 ;IHS/ANMC/LJF 10/5/2000 no pattern
IF '$ORDER(^SC(SDC,"ST",0))
QUIT
+3 SET $PIECE(^UTILITY($JOB,"SDNMS",D,SDNM),"^",3)=SDC
+4 QUIT
NM ;called by SDCLAV1 - SD/517 CHANGED FOR LOOP
+1 SET SDAP1=0
FOR
SET SDAP1=$ORDER(^SC(SDC,"S",SDAP,1,SDAP1))
IF 'SDAP1
QUIT
DO NM1
+2 ; SD*5.3*439 added Kill of local vars
KILL M1,SDN1,SDN2,SDN3,SDC3,SDAP1
+3 QUIT
NM1 ;added SD/517
IF '$DATA(^SC(SDC,"S",SDAP,1,SDAP1,0))
NEW POP
SET POP=0
SET (SDN1,SDN2,SDN3)=""
DO CHECK
DO KILL
QUIT
+1 ;SD*509
IF $PIECE(^SC(SDC,"S",SDAP,1,SDAP1,0),U,1)=""
DO SETUTL
QUIT
+2 ;S SDN1=+^SC(SDC,"S",SDAP,1,SDAP1,0),M1=$P(^(0),"^",2),SDC3=$P(^(0),"^",9),SDN2=$P(^DPT(+SDN1,0),"^"),SDN3=$P(^(0),"^",9),SDN3=$S(SDN3="":"UNKNOWN",1:SDN3) I $D(SDCI) D NM2 Q
+3 ;IHS/ANMC/LJF 10/5/2000
SET SDN1=+^SC(SDC,"S",SDAP,1,SDAP1,0)
SET M1=$PIECE(^(0),"^",2)
SET SDC3=$PIECE(^(0),"^",9)
SET SDN2=$PIECE(^DPT(+SDN1,0),"^")
SET SDN3=$PIECE(^(0),"^",9)
SET SDN3=$$HRCN^BDGF2(+SDN1,+$$FAC^BSDU(SDC))
SET SDN3=$SELECT(SDN3="":"UNKNOWN",1:SDN3)
IF $DATA(SDCI)
DO NM2
QUIT
+4 ; SD*5.3*439 added quit if clinic in "S" node not = to selected clinic
+5 IF '$DATA(SDCI)
IF $DATA(^DPT(SDN1,"S",SDAP,0))
IF $PIECE(^(0),"^",2)'["C"
IF $PIECE(^(0),"^",2)'="N"
IF $PIECE(^(0),"^",2)'="NA"
IF $PIECE(^(0),U,1)'=SDC
QUIT
DO NM2
QUIT
+6 QUIT
+7 ;SD*5.3*490 do not display appts prior to clinic start date
NM2 ;SD*5.3*490
IF $PIECE(SDAP,".",1)<$ORDER(^SC(SDC,"T",0))
QUIT
+1 IF $DATA(^DPT(SDN1,"S",SDAP,0))
SET ^UTILITY($JOB,"SDNMS",D,SDV,SDAP,SDN2,SDN3)=M1_$SELECT(($PIECE(^DPT(SDN1,"S",SDAP,0),"^",2)["C"):"^*",SDC3="C":"^*",($PIECE(^(0),"^",2)="N"):"^**",($PIECE(^(0),"^",2)="NA"):"^**",1:"")
+2 IF $DATA(^DPT(SDN1,"S",SDAP,0))
SET $PIECE(^UTILITY($JOB,"SDNMS",D,SDV,SDAP,SDN2,SDN3),"^",3)=$SELECT($PIECE(^DPT(SDN1,"S",SDAP,0),"^",7)=4:"***",1:"")
+3 QUIT
+4 ;
CHECK ;Added SD/517
+1 NEW SDIEN,NODE,NODE0,HDFN,HDNAM,HDSN,POP
+2 SET SDIEN=0
SET NODE=""
SET HDAP1=SDAP1
+3 FOR
SET SDIEN=$ORDER(^SCE("B",SDAP,SDIEN))
IF 'SDIEN
QUIT
Begin DoDot:1
+4 SET NODE=^SCE(SDIEN,0)
+5 IF $PIECE(NODE,U,4)'=SDC
QUIT
+6 SET HDFN=$PIECE(NODE,U,2)
SET HDNAM=$PIECE(^DPT(HDFN,0),U)
SET HDSN=$PIECE(^(0),U,9)
+7 IF $DATA(^UTILITY($JOB,"SDNMS",D,SDV,SDAP,HDNAM,HDSN))
QUIT
+8 SET POP=0
DO CHECK1
IF POP
QUIT
+9 SET SDN1=$PIECE(NODE,U,2)
SET SDN2=$PIECE(^DPT(SDN1,0),U)
SET SDN3=$PIECE(^DPT(SDN1,0),U,9)
SET M1=""
SET SDC3=""
+10 DO NM2
End DoDot:1
+11 QUIT
+12 ;
CHECK1 ;Added SD/517
+1 SET HDAP1=$ORDER(^SC(SDC,"S",SDAP,1,HDAP1))
IF 'HDAP1
QUIT
+2 IF '$DATA(^SC(SDC,"S",SDAP,1,HDAP1,0))
QUIT
SET NODE0=^(0)
+3 IF $PIECE(NODE0,U,1)=HDFN
SET POP=1
QUIT
+4 QUIT
+5 ;
KILL ;added SD/517
KILL SDIEN,NODE,NODE0,POP,HDFN,HDNAM,HDSN,HDAP1
+1 QUIT
+2 ;
SETUTL ;SD*509 set Utility for null DFN, corrupt node will be deleted in SDCLAV1
+1 SET (SDN1,SDN2,SDN3)="UNKNOWN"
SET M1=0
+2 SET ^UTILITY($JOB,"SDNMS",D,SDV,SDAP,SDN2,SDN3)=M1_"^"_SDC_"^"_SDAP1
+3 QUIT
+4 ;
