Routine: ACHSYPCN

ACHSYPCN ; IHS/ITSC/PMF - ENTER DOCUMENTS (2/8)-(PT,HRN,FAC,EDOS,PRO) ;    [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

        ;;3.1T1;CONTRACT HEALTH MGMT SYSTEM;;DEC 20, 2000

 ;simple util to count the number of patients for a facility

 ;in a given fiscal year

 ;ASK for facility

 ;ASK for a fiscal year

 ;FOR each document

 ;  IF it is the right fiscal year, THEN

 ;    get the patient number

 ;    IF the patient is not already counted, THEN

 ;       add one to count

 ;       place patient on list

 ;    endif

 ;  endif

 ;endfor

 ;Write count

 K ^TEMP("ACHSYPCN")

 S OK=0 D GETFAC Q:'OK

 W !!!!!!!,"Enter Fiscal Year final digit, for example",!,?4,"enter 1997 as 7:   " R FY:300

 I FY="" Q

 S (COUNT,DOC)=0 F XI=1:1 S DOC=$O(^ACHSF(FAC,"D",DOC)) Q:DOC=""  D

 . I XI#25=0 W " ."

 . S X=$G(^ACHSF(FAC,"D",DOC,0)),Y=$P(X,"^",22),Y2=$P(X,"^",14)

 . I Y2'=FY Q

 . I Y="" Q

 . I $D(^TEMP("ACHSYPCN",Y)) Q

 . S COUNT=COUNT+1

 . S ^TEMP("ACHSYPCN",Y)=""

. Q

 W !!!,"Total patients = ",COUNT

 K ^TEMP("ACHSYPCN")

GETFAC ;

 W !!!!,"Enter Facility number:   "

 R R:300

 I R="" Q

 I R="Y" D  G GETFAC

 . W ! S FAC="" F  S FAC=$O(^ACHSF("B",FAC)) Q:FAC=""  W !,?4,FAC

 . W !

. Q

 I '$D(^ACHSF("B",R)) W "  Invalid entry" G GETFAC

 S FAC=R,OK=1

ACHSYPCN  ; IHS/ITSC/PMF - ENTER DOCUMENTS (2/8)-(PT,HRN,FAC,EDOS,PRO) ;    [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;;3.1T1;CONTRACT HEALTH MGMT SYSTEM;;DEC 20, 2000

 +3       ;

 +4       ;simple util to count the number of patients for a facility

 +5       ;in a given fiscal year

 +6       ;

 +7       ;ASK for facility

 +8       ;ASK for a fiscal year

 +9       ;

 +10      ;FOR each document

 +11      ;  IF it is the right fiscal year, THEN

 +12      ;    get the patient number

 +13      ;    IF the patient is not already counted, THEN

 +14      ;       add one to count

 +15      ;       place patient on list

 +16      ;    endif

 +17      ;  endif

 +18      ;endfor

 +19      ;

 +20      ;Write count

 +21      ;

 +22      ;

 +23       KILL ^TEMP("ACHSYPCN")

 +24       SET OK=0

           DO GETFAC

           IF 'OK

               QUIT

 +25      ;

 +26       WRITE !!!!!!!,"Enter Fiscal Year final digit, for example",!,?4,"enter 1997 as 7:   "

           READ FY:300

 +27       IF FY=""

               QUIT

 +28      ;

 +29       SET (COUNT,DOC)=0

           FOR XI=1:1

               SET DOC=$ORDER(^ACHSF(FAC,"D",DOC))

               IF DOC=""

                   QUIT

               Begin DoDot:1

 +30               IF XI#25=0

                       WRITE " ."

 +31               SET X=$GET(^ACHSF(FAC,"D",DOC,0))

                   SET Y=$PIECE(X,"^",22)

                   SET Y2=$PIECE(X,"^",14)

 +32               IF Y2'=FY

                       QUIT

 +33               IF Y=""

                       QUIT

 +34               IF $DATA(^TEMP("ACHSYPCN",Y))

                       QUIT

 +35               SET COUNT=COUNT+1

 +36               SET ^TEMP("ACHSYPCN",Y)=""

 +37               QUIT

               End DoDot:1

 +38      ;

 +39       WRITE !!!,"Total patients = ",COUNT

 +40       KILL ^TEMP("ACHSYPCN")

 +41       QUIT

 +42      ;

GETFAC    ;

 +1        WRITE !!!!,"Enter Facility number:   "

 +2        READ R:300

 +3        IF R=""

               QUIT

 +4        IF R="Y"

               Begin DoDot:1

 +5                WRITE !

                   SET FAC=""

FOR

                       SET FAC=$ORDER(^ACHSF("B",FAC))

                       IF FAC=""

                           QUIT

                       WRITE !,?4,FAC

 +6                WRITE !

 +7                QUIT

               End DoDot:1

               GOTO GETFAC

 +8        IF '$DATA(^ACHSF("B",R))

               WRITE "  Invalid entry"

               GOTO GETFAC

 +9        SET FAC=R

           SET OK=1

 +10       QUIT

ACHSYPCN.m