- 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
