CIMGAGP0 ; CMI/TUCSON/LAB - DEVICE CALLS AND QUEUING ; [ 01/31/00 8:34 AM ]
;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
SU ;EP;FIND SERVICE UNIT COMMUNITIES
N I,J,K,X,Y,Z,CIMTMP
S J=0
F I=1:1 S Z=$T(SUTEXT+I) Q:Z=""!$D(CIMQUIT) D
.S CIMTAX=$P(Z,";",3)
.Q:CIMTAX=""
.S Y=$O(^ATXAX("B",CIMTAX,0))
.I 'Y K CIMTAX Q
.S J=J+1
.S CIMTMP(J)=Y_";"_$P(Z,";",2,3)
D SSU:$D(CIMTMP)
Q
DIR ;EP;
I $D(CIMOUT) K DIR S Y="" Q
K DTOUT,DUOUT,CIMQUIT,CIMOUT
D ^DIR
S CIMY=Y
S:$D(DIRUT)!$D(DIROUT)!$D(DUOUT) CIMQUIT=""
S:X="^^"!$D(DTOUT) (CIMQUIT,CIMOUT)=""
K DIR,DIRUT,DIROUT,DUOUT,DTOUT
Q
SSU ;SELECT SERVICE UNIT COMMUNITY TAXONOMY
I J=1 S Y=1 D SSU1 Q
N I,J,K
W !!?5,"Service Unit Community Taxonomies"
W !!?5,"NO.",?10,"Service Unit"
W !?5,"---",?10,"---------------"
S (I,J)=0
F S J=$O(CIMTMP(J)) Q:'J D
.S Z=CIMTMP(J)
.W !?5,J,?10,$P(Z,";",2)
.S I=I+1
S DIR(0)="NO^1:"_I
S DIR("A")="Which SERVICE UNIT Taxonomy"
W !
D DIR
I Y<1 S CIMQUIT="" Q
SSU1 I '$G(CIMTMP(Y)) S CIMQUIT="" Q
S CIMZ=CIMTMP(Y)
S CIMX=+CIMTMP(Y)
S CIMTAX=$P(CIMZ,";",3)
;D LIST
;Q:$D(CIMQUIT)
D SU1
Q
SU1 S X=0
F S X=$O(^ATXAX(CIMX,21,X)) Q:'X D
.S CIMTAX($P(^ATXAX(CIMX,21,X,0),U))=""
.Q
I $D(CIMTAX)=11 D
.S CIMQUIT=""
.;S CIMSU=$P(CIMZ,";",2)
K CIMQUIT
Q
SUTEXT ;;
;Cheyenne River;ebutte117
;Crow Creek;Crowcreek2
;Spirit Lake Sioux;fort totten
;Flandreau;Fland117
;Lower Brule;lobrule117
;Oglala Sioux;PINERIDGE117
;Kyle;kyle117
;Wanblee;wanblee117
;Omaha;Macy117
;N. Ponca;ponca117
;Rapid City;rapid117
;Rosebud;rose117
;Sac & Fox;sacfox117
;Santee Sioux;santee117
;Sisseton-Wahpeton;siss_117
;Standing Rock;ftyate117
;McLaughlin;mclaugh117
;Three Affiliated;Ft_BERTH117
;Trenton;trent117
;Turtle Mountain;belc117
;Winnebago;winne117
;Yankton;wagner117
;
CIMGAGP0 ; CMI/TUCSON/LAB - DEVICE CALLS AND QUEUING ; [ 01/31/00 8:34 AM ]
+1 ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
SU ;EP;FIND SERVICE UNIT COMMUNITIES
+1 NEW I,J,K,X,Y,Z,CIMTMP
+2 SET J=0
+3 FOR I=1:1
SET Z=$TEXT(SUTEXT+I)
IF Z=""!$DATA(CIMQUIT)
QUIT
Begin DoDot:1
+4 SET CIMTAX=$PIECE(Z,";",3)
+5 IF CIMTAX=""
QUIT
+6 SET Y=$ORDER(^ATXAX("B",CIMTAX,0))
+7 IF 'Y
KILL CIMTAX
QUIT
+8 SET J=J+1
+9 SET CIMTMP(J)=Y_";"_$PIECE(Z,";",2,3)
End DoDot:1
+10 IF $DATA(CIMTMP)
DO SSU
+11 QUIT
DIR ;EP;
+1 IF $DATA(CIMOUT)
KILL DIR
SET Y=""
QUIT
+2 KILL DTOUT,DUOUT,CIMQUIT,CIMOUT
+3 DO ^DIR
+4 SET CIMY=Y
+5 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)
SET CIMQUIT=""
+6 IF X="^^"!$DATA(DTOUT)
SET (CIMQUIT,CIMOUT)=""
+7 KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT
+8 QUIT
SSU ;SELECT SERVICE UNIT COMMUNITY TAXONOMY
+1 IF J=1
SET Y=1
DO SSU1
QUIT
+2 NEW I,J,K
+3 WRITE !!?5,"Service Unit Community Taxonomies"
+4 WRITE !!?5,"NO.",?10,"Service Unit"
+5 WRITE !?5,"---",?10,"---------------"
+6 SET (I,J)=0
+7 FOR
SET J=$ORDER(CIMTMP(J))
IF 'J
QUIT
Begin DoDot:1
+8 SET Z=CIMTMP(J)
+9 WRITE !?5,J,?10,$PIECE(Z,";",2)
+10 SET I=I+1
End DoDot:1
+11 SET DIR(0)="NO^1:"_I
+12 SET DIR("A")="Which SERVICE UNIT Taxonomy"
+13 WRITE !
+14 DO DIR
+15 IF Y<1
SET CIMQUIT=""
QUIT
SSU1 IF '$GET(CIMTMP(Y))
SET CIMQUIT=""
QUIT
+1 SET CIMZ=CIMTMP(Y)
+2 SET CIMX=+CIMTMP(Y)
+3 SET CIMTAX=$PIECE(CIMZ,";",3)
+4 ;D LIST
+5 ;Q:$D(CIMQUIT)
+6 DO SU1
+7 QUIT
SU1 SET X=0
+1 FOR
SET X=$ORDER(^ATXAX(CIMX,21,X))
IF 'X
QUIT
Begin DoDot:1
+2 SET CIMTAX($PIECE(^ATXAX(CIMX,21,X,0),U))=""
+3 QUIT
End DoDot:1
+4 IF $DATA(CIMTAX)=11
Begin DoDot:1
+5 SET CIMQUIT=""
+6 ;S CIMSU=$P(CIMZ,";",2)
End DoDot:1
+7 KILL CIMQUIT
+8 QUIT
SUTEXT ;;
+1 ;Cheyenne River;ebutte117
+2 ;Crow Creek;Crowcreek2
+3 ;Spirit Lake Sioux;fort totten
+4 ;Flandreau;Fland117
+5 ;Lower Brule;lobrule117
+6 ;Oglala Sioux;PINERIDGE117
+7 ;Kyle;kyle117
+8 ;Wanblee;wanblee117
+9 ;Omaha;Macy117
+10 ;N. Ponca;ponca117
+11 ;Rapid City;rapid117
+12 ;Rosebud;rose117
+13 ;Sac & Fox;sacfox117
+14 ;Santee Sioux;santee117
+15 ;Sisseton-Wahpeton;siss_117
+16 ;Standing Rock;ftyate117
+17 ;McLaughlin;mclaugh117
+18 ;Three Affiliated;Ft_BERTH117
+19 ;Trenton;trent117
+20 ;Turtle Mountain;belc117
+21 ;Winnebago;winne117
+22 ;Yankton;wagner117
+23 ;
