SDCLAV0.m

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       ;