- 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 ;
