Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSYPCN

ACHSYPCN.m

Go to the documentation of this file.
  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
  1. ;;3.1T1;CONTRACT HEALTH MGMT SYSTEM;;DEC 20, 2000
  1. ;
  1. ;simple util to count the number of patients for a facility
  1. ;in a given fiscal year
  1. ;
  1. ;ASK for facility
  1. ;ASK for a fiscal year
  1. ;
  1. ;FOR each document
  1. ; IF it is the right fiscal year, THEN
  1. ; get the patient number
  1. ; IF the patient is not already counted, THEN
  1. ; add one to count
  1. ; place patient on list
  1. ; endif
  1. ; endif
  1. ;endfor
  1. ;
  1. ;Write count
  1. ;
  1. ;
  1. K ^TEMP("ACHSYPCN")
  1. S OK=0 D GETFAC Q:'OK
  1. ;
  1. W !!!!!!!,"Enter Fiscal Year final digit, for example",!,?4,"enter 1997 as 7: " R FY:300
  1. I FY="" Q
  1. ;
  1. S (COUNT,DOC)=0 F XI=1:1 S DOC=$O(^ACHSF(FAC,"D",DOC)) Q:DOC="" D
  1. . I XI#25=0 W " ."
  1. . S X=$G(^ACHSF(FAC,"D",DOC,0)),Y=$P(X,"^",22),Y2=$P(X,"^",14)
  1. . I Y2'=FY Q
  1. . I Y="" Q
  1. . I $D(^TEMP("ACHSYPCN",Y)) Q
  1. . S COUNT=COUNT+1
  1. . S ^TEMP("ACHSYPCN",Y)=""
  1. . Q
  1. ;
  1. W !!!,"Total patients = ",COUNT
  1. K ^TEMP("ACHSYPCN")
  1. Q
  1. ;
  1. GETFAC ;
  1. W !!!!,"Enter Facility number: "
  1. R R:300
  1. I R="" Q
  1. I R="Y" D G GETFAC
  1. . W ! S FAC="" F S FAC=$O(^ACHSF("B",FAC)) Q:FAC="" W !,?4,FAC
  1. . W !
  1. . Q
  1. I '$D(^ACHSF("B",R)) W " Invalid entry" G GETFAC
  1. S FAC=R,OK=1
  1. Q