ASDHS1.m

ASDHS1 ; IHS/ADC/PDW/ENM - HS BY CLINIC CONT. ;  [ 03/25/1999  11:48 AM ]

 ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 ;IHS/HQW/KML 2/19/97  replace ^UTILITY with ^TMP per SAC 2.3.2.5

 ;

GOT ;EP; called by ASDHS to put into correct sort order

 NEW DFN,TDO

 S DFN=$P(^SC(ASDX,"S",ASDT,1,ASDY,0),U)

 S TDO=$$HRN^ASDUT(DFN),TDO=$P(TDO,"-",3)_$P(TDO,"-",2)

 D CLO:ORDER=2,PCO:ORDER=3

 Q

 ;

PCO ; by prin clinic order

 NEW ASDZ,ASDP

 S ASDZ=$P($G(^SC(ASDX,"SL")),U,5),ASDZ=$S(+ASDZ:ASDZ,1:ASDX)

 S ASDP=$S($D(^SC(ASDZ,0)):$P(^(0),U),1:ASDZ)

 S ^TMP("SDHS",$J,"A",ASDP," "_TDO,DFN)=ASDX

 Q

 ;

CLO ; by clinics selected

 NEW ASDN

 S ASDN=$P($G(^SC(ASDX,0)),U)

 S ^TMP("SDHS",$J,"A",ASDN," "_TDO,DFN)=ASDX

 Q

 ;

GO ;EP; called to loop thru sorted list

 NEW ASDI,ASDJ,ASDK,ASDX

 S ASDI=0 F  S ASDI=$O(^TMP("SDHS",$J,"A",ASDI)) Q:ASDI=""  D

 . S ASDJ=0 F  S ASDJ=$O(^TMP("SDHS",$J,"A",ASDI,ASDJ)) Q:ASDJ=""  D

 .. S ASDK=0

 .. F  S ASDK=$O(^TMP("SDHS",$J,"A",ASDI,ASDJ,ASDK)) Q:'ASDK  D

 ... S ASDX=^TMP("SDHS",$J,"A",ASDI,ASDJ,ASDK)

 ... D HS,MP,AIU

 W:IOF]"" !,@IOF G END^SDROUT1

 ;

HS ; -- health summary

 Q:$G(SDZHS)

 Q:$P($G(^SC(+ASDX,9999999)),U)'="Y"

 S X=$$HSTYP^ASDUT(+ASDX,ASDK) Q:X=""

 D HS^ASDFORM(ASDK,X) Q

 ;

MP ; -- med profile

 Q:$G(SDZMP)

 Q:$P($G(^SC(ASDX,9999999)),U,3)'="Y"

 D MP^ASDFORM(ASDK)

 Q

 ;

AIU ; -- address update

 Q:$G(SDZAI)

 Q:$P($G(^SC(ASDX,9999999)),U,4)'="Y"

 D AIU^ASDFORM(ASDK)

 Q

ASDHS1    ; IHS/ADC/PDW/ENM - HS BY CLINIC CONT. ;  [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 +2       ;IHS/HQW/KML 2/19/97  replace ^UTILITY with ^TMP per SAC 2.3.2.5

 +3       ;

GOT       ;EP; called by ASDHS to put into correct sort order

 +1        NEW DFN,TDO

 +2        SET DFN=$PIECE(^SC(ASDX,"S",ASDT,1,ASDY,0),U)

 +3        SET TDO=$$HRN^ASDUT(DFN)

           SET TDO=$PIECE(TDO,"-",3)_$PIECE(TDO,"-",2)

 +4        IF ORDER=2

               DO CLO

           IF ORDER=3

               DO PCO

 +5        QUIT 

 +6       ;

PCO       ; by prin clinic order

 +1        NEW ASDZ,ASDP

 +2        SET ASDZ=$PIECE($GET(^SC(ASDX,"SL")),U,5)

           SET ASDZ=$SELECT(+ASDZ:ASDZ,1:ASDX)

 +3        SET ASDP=$SELECT($DATA(^SC(ASDZ,0)):$PIECE(^(0),U),1:ASDZ)

 +4        SET ^TMP("SDHS",$JOB,"A",ASDP," "_TDO,DFN)=ASDX

 +5        QUIT 

 +6       ;

CLO       ; by clinics selected

 +1        NEW ASDN

 +2        SET ASDN=$PIECE($GET(^SC(ASDX,0)),U)

 +3        SET ^TMP("SDHS",$JOB,"A",ASDN," "_TDO,DFN)=ASDX

 +4        QUIT 

 +5       ;

GO        ;EP; called to loop thru sorted list

 +1        NEW ASDI,ASDJ,ASDK,ASDX

 +2        SET ASDI=0

           FOR 

               SET ASDI=$ORDER(^TMP("SDHS",$JOB,"A",ASDI))

               IF ASDI=""

                   QUIT 

               Begin DoDot:1

 +3                SET ASDJ=0

                   FOR 

                       SET ASDJ=$ORDER(^TMP("SDHS",$JOB,"A",ASDI,ASDJ))

                       IF ASDJ=""

                           QUIT 

                       Begin DoDot:2

 +4                        SET ASDK=0

 +5                        FOR 

                               SET ASDK=$ORDER(^TMP("SDHS",$JOB,"A",ASDI,ASDJ,ASDK))

                               IF 'ASDK

                                   QUIT 

                               Begin DoDot:3

 +6                                SET ASDX=^TMP("SDHS",$JOB,"A",ASDI,ASDJ,ASDK)

 +7                                DO HS

                                   DO MP

                                   DO AIU

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +8        IF IOF]""

               WRITE !,@IOF

           GOTO END^SDROUT1

 +9       ;

HS        ; -- health summary

 +1        IF $GET(SDZHS)

               QUIT 

 +2        IF $PIECE($GET(^SC(+ASDX,9999999)),U)'="Y"

               QUIT 

 +3        SET X=$$HSTYP^ASDUT(+ASDX,ASDK)

           IF X=""

               QUIT 

 +4        DO HS^ASDFORM(ASDK,X)

           QUIT 

 +5       ;

MP        ; -- med profile

 +1        IF $GET(SDZMP)

               QUIT 

 +2        IF $PIECE($GET(^SC(ASDX,9999999)),U,3)'="Y"

               QUIT 

 +3        DO MP^ASDFORM(ASDK)

 +4        QUIT 

 +5       ;

AIU       ; -- address update

 +1        IF $GET(SDZAI)

               QUIT 

 +2        IF $PIECE($GET(^SC(ASDX,9999999)),U,4)'="Y"

               QUIT 

 +3        DO AIU^ASDFORM(ASDK)

 +4        QUIT