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

ACHSPOST.m

Go to the documentation of this file. 
  1. ACHSPOST ; IHS/ITSC/TPF/PMF - POST INIT FOR CHS DENIALS/DEFERRED SVCS ; JUL 10, 2008 
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14**;JUN 11,2001
  1.  ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  ;
  1.  S $ZT="ERROR^"_$ZN
  1.  ;
  1.  ;if this is a restart, certain vars won't be set.  we can set
  1.  ;them now, restart or not, and no harm done
  1.  S U="^"
  1.  S ACHSVERS="V"_$P($T(+2),";",3)
  1.  S $P(LINE,"*",81)=""
  1.  ;
  1.  ;set the time, record the start
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,$ZN,"ENTERED")=NOW
  1.  ;
  1.  I $D(^ACHSINST(ACHSVERS,"ERROR")) S ^ACHSINST(ACHSVERS,"ERROR","PREVIOUS ERRORS HAVE NOT BEEN CLEARED")=NOW S ERROR=1,XPDABORT=1 D START^ACHSPOSM(ERROR) Q
  1.  ;
  1.  ;
  1.  I '$D(^ACHSINST(ACHSVERS,"ACHSPRE","FINISHED")) W !!,"ACHSPOST IS DEPENDENT ON ACHSPRE!!" S XPDABORT=1,ERROR=1,^ACHSINST(ACHSVERS,"ERROR","ATTEMPT VIA "_$ZN,"CHS INSTALL","STATUS")="ACHSPRE NOT RUN"_U_NOW D START^ACHSPOSM(ERROR) Q
  1.  ;
  1.  ;
  1.  N ACHD,ACHDPT,ACHDX,ACHDY,ACHDZ,DA,DIC,DIE,DIK,DD,DO,DR
  1.  ;
  1.  W !!,"Beginning CHS 3.1 Post Init at ",$$FMTE^XLFDT(NOW),!!
  1.  ;
  1.  ;
  1.  ;
  1.  D DIVCHK     ;CHECK ACTIVE DIVISIONS ON THIS SYSTEM
  1.               ;USED LATER TO SET UP DICTIONARY GLOBALS
  1.               ;
  1.  ;
  1.  W !!,LINE
  1.  D DDCHECK    ;CHECK TO SEE IF DENIAL DATA DICTIONARIES WERE INITILAIZED
  1.               ;PROPERLY
  1.  ;
  1.  I ERROR=2 D
  1.  .W !!,"WARNING: The following files may have an error in the zero"
  1.  .W !,"node of the data dictionary entry. Please report this to ITSC"
  1.  .W !!
  1.  .S FILE=""
  1.  .F  S FILE=$O(ERRLIST(FILE)) Q:FILE=""  D
  1.  ..S FILENAME=$O(^DD(FILE,0,"NM",""))
  1.  ..W !?10,FILE,?20,FILENAME
  1.  .D START^ACHSPOSM(ERROR)
  1.  ;
  1.  W !!,LINE
  1.  ;
  1.  ;THE FOLLOWING DATA IS ONLY LOADED IF THE DATA DOES NOT ALREADY EXIST
  1.  ;ON THE INSTALLING SYSTEM. EXCEPT DENIAL REASONS. EXISTING DENIAL
  1.  ;ARE DE-ACTIVATED AND NEW ONES APPROVED BY CHS WORKGROUP ARE ADDED.
  1.  ;
  1.  D ^ACHSPOS1   ;DEFERRED SERVICE LETTER FORCE ENTRY
  1.  ;              DENIAL STATUS FORCE ENTRY
  1.  ;
  1.  D ^ACHSPOS2   ;CALLS ACHSPOS3, DATA FOR DENIAL REASONS
  1.  ;
  1.  D ^ACHSPOS4   ;DATA FOR DENIAL FACILITY FILE
  1.  ;
  1.  D ^ACHSPOS5   ;DATA FOR MEDICAL PRIORITY FILE
  1.  ;
  1.  D ^ACHSPOS6   ; DATA FOR DEFERRED SERVICES CATEGORY FILE 
  1.  ;
  1.  D ^ACHSCONV   ;CONVERT CHS DENIAL DATA TO ACHS DATA STRUCTURE
  1.  ;
  1.  D KEYASS      ;ASSIGN THE 'ACHSZMENU' KEY TO ALL USERS WHO HAVE THE
  1.                ;'ACHSMENU' OPTION
  1.  ;
  1.  ;D PULLCPT     ;PULL ALL CPT ENTRIES IN ALL CHS DOCUMENTS AND DELETE
  1.  ;             ;POINTERS TO CPT ENTRIES WITH "unknown" IN PIECE 2 OF
  1.  ;             ;NODE 1
  1.  ; 
  1.  D ^ACHSXREF    ;LOOK AT DANGLING X-REFS IN DOCUMENT FILE AND DELETE
  1.  ;              ALSO WILL REPORT ON POSSIBLE ENTRIES THAT MAY BE FIXED
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,$ZN,"FINISHED")=NOW
  1.  ;
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1.  ;GET LIST OF ALL DIVISIONS ASSIGNED TO ACTIVE USERS ON THE SYSTEM
  1. DIVCHK ;EP from ACHSPOS4
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DIVCHK^"_$ZN,"ENTERED")=NOW
  1.  ;
  1.  ;
  1.  W !!,LINE
  1.  W !!,"The following is a list of active facilities that have been"
  1.  W !,"assigned to active users. You may want to review this list"
  1.  W !,"to determine whether these are correct or not."
  1.  ;
  1.  W !!,"If the 'CHS DENIAL FACILITY' file does NOT exist, the install"
  1.  W !,"will create an entry in the 'CHS DENIAL FACILITY' file so"
  1.  W !,"denials can be entered for these facilities. Otherwise the"
  1.  W !,"Site Manager will have to enter new denial facilities as"
  1.  W !,"required."
  1.  W !!
  1.  S ACHSPERS=0
  1.  F  S ACHSPERS=$O(^VA(200,ACHSPERS)) Q:+ACHSPERS=0  D
  1.  .Q:$P($G(^VA(200,ACHSPERS,0)),U,11)'=""    ;TERMINATION DATE
  1.  .Q:$P($G(^VA(200,ACHSPERS,"PS")),U,4)'=""  ;INACTIVE DATE
  1.  .S ACHSDIV=0
  1.  .F  S ACHSDIV=$O(^VA(200,ACHSPERS,2,ACHSDIV)) Q:+ACHSDIV=0  D
  1.  ..;IS THE 'INACTIVE FACILITY FLAG' SET?
  1.  ..Q:$P($G(^DIC(4,ACHSDIV,99)),U,4)="Y"!($P($G(^DIC(4,ACHSDIV,99)),U,4)="y")
  1.  ..S ^ACHSINST(ACHSVERS,$ZN,"ACTIVE FACILITIES",ACHSDIV)=$P($G(^DIC(4,ACHSDIV,0)),U)
  1.  ;FOLLOWING JUST FOR TESTING
  1.  W !!,"FACILITY IEN",?15,"FACILITY NAME"
  1.  W !,"------------",?15,"-------------"
  1.  S ACHSDIV=""
  1.  F  S ACHSDIV=$O(^ACHSINST(ACHSVERS,$ZN,"ACTIVE FACILITIES",ACHSDIV)) Q:ACHSDIV=""  D
  1.  .S ACHSDNM=$P($G(^DIC(4,ACHSDIV,0),"UNDEFINED"),U)
  1.  .W !,ACHSDIV,?15,ACHSDNM
  1.  ;
  1.  W !!,LINE
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DIVCHK^"_$ZN,"FINISHED")=NOW
  1.  Q
  1.  ;
  1.  ;ASSIGN 'ACHSZMENU' KEY TO 'ACHSMENU' OPTION HOLDERS
  1. KEYASS ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S CURDATE=X
  1.  S OKEYNUM=$O(^DIC(19.1,"B","ACHSZMENU",""))  ;GET IEN OF OLD MENU KEY
  1.  ;
  1.  S NKEYNUM=$O(^DIC(19.1,"B","ACHSZDEFDENMENU",""))  ;NEW KEY NUMBER
  1.  Q:NKEYNUM=""
  1.  S PERSIEN=0
  1.  F  S PERSIEN=$O(^VA(200,PERSIEN)) Q:+PERSIEN=0  D
  1.  .;QUIT IF THE PERSON DOESN'T HAVE EITHER OF THE NEW OR OLD KEYS
  1.  .Q:'$D(^VA(200,PERSIEN,51,"B",OKEYNUM))&('$D(^VA(200,PERSIEN,51,"B",OKEYNUM)))
  1.  .W !!,"PERSON CURRENTLY HAS NEW OR OLD KEY: ",!,$P($G(^VA(200,PERSIEN,0)),U)
  1.  .S TERMDT=$P($G(^VA(200,PERSIEN,0)),U,11)
  1.  .S:TERMDT="" TERMDT=9999999
  1.  .;
  1.  .I TERMDT<CURDATE!(TERMDT=CURDATE) W !,"PERSON DEACTIVATED! KEY NOT ADDED" Q
  1.  .I $D(^VA(200,PERSIEN,51,"B",NKEYNUM)) S X="ACHSZMENU",DA(1)=PERSIEN,DIC(0)="L",DIC="^VA(200,"_DA(1)_",51,",DLAYGO=200 D ^DIC W !,"PERSON ALREADY HAS NEW KEY! ASSIGNING OLD KEY"
  1.  .I $D(^VA(200,PERSIEN,51,"B",OKEYNUM)) S X="ACHSZDEFDENMENU",DA(1)=PERSIEN,DIC(0)="L",DIC="^VA(200,"_DA(1)_",51,",DLAYGO=200 D ^DIC W !,"PERSON ALREADY HAS NEW KEY! ASSIGNING OLD KEY"
  1.  .;
  1.  .S ^ACHSINST(ACHSVERS,$ZN,"KEY ASSIGNMENTS",PERSIEN)=$P($G(^VA(200,PERSIEN,0)),U)
  1.  .W ?50,"KEY ADDED TO ACTIVE USER"
  1.  ;
  1.  Q
  1.  ;CHECK DENIAL DATA DICTIONARIES  - JUST A WARNING
  1. DDCHECK ;
  1.  S ERROR=0
  1.  S ERRLIST=""
  1.  I $P($G(^DD(9002061,0)),U,4)'=2 D SET(9002061) S ERROR=2,ERRLIST(9002061)=""
  1.  I $P($G(^DD(9002062,0)),U,4)'=5 D SET(9002062) S ERROR=2,ERRLIST(9002062)=""
  1.  I $P($G(^DD(9002063,0)),U,4)'=2 D SET(9002063) S ERROR=2,ERRLIST(9002063)=""
  1.  I $P($G(^DD(9002064,0)),U,4)'=6 D SET(9002064) S ERROR=2,ERRLIST(9002064)=""
  1.  I $P($G(^DD(9002064.1,0)),U,4)'=2 D SET(9002064.1) S ERROR=2,ERRLIST(9002064.1)=""
  1.  I $P($G(^DD(9002065,0)),U,4)'=42 D SET(9002065) S ERROR=2,ERRLIST(9002065)=""
  1.  I $P($G(^DD(9002066,0)),U,4)'=4 D SET(9002066) S ERROR=2,ERRLIST(9002066)=""
  1.  I $P($G(^DD(9002066.5,0)),U,4)'=4 D SET(9002066.5) S ERROR=2,ERRLIST(9002066.5)=""
  1.  I $P($G(^DD(9002067,0)),U,4)'=3 D SET(9002067) S ERROR=2,ERRLIST(90020667)=""
  1.  I $P($G(^DD(9002068,0)),U,4)'=2 D SET(9002068) S ERROR=2,ERRLIST(9002068)=""
  1.  I $P($G(^DD(9002069,0)),U,4)'=14 D SET(9002069) S ERROR=2,ERRLIST(9002069)=""
  1.  I $P($G(^DD(9002070,0)),U,4)'=2 D SET(9002070) S ERROR=2,ERRLIST(9002070)=""
  1.  I $P($G(^DD(9002071,0)),U,4)'=2 D SET(9002071) S ERROR=2,ERRLIST(9002071)=""
  1.  I $P($G(^DD(9002072,0)),U,4)'=33 D SET(9002072) S ERROR=2,ERRLIST(9002072)=""
  1.  I $P($G(^DD(9002072.1,0)),U,4)'=9 D SET(9002072.1) S ERROR=2,ERRLIST(9002072.1)=""
  1.  I $P($G(^DD(9002073,0)),U,4)'=5 D SET(9002073) S ERROR=2,ERRLIST(9002073)=""
  1.  I $P($G(^DD(9002073.1,0)),U,4)'=5 D SET(9002073.1) S ERROR=2,ERRLIST(9002073.1)=""
  1.  I $P($G(^DD(9002074,0)),U,4)'=3 D SET(9002074) S ERROR=2,ERRLIST(9002074)=""
  1.  I $P($G(^DD(9002075,0)),U,4)'=2 D SET(9002075) S ERROR=2,ERRLIST(9002075)=""
  1.  I $P($G(^DD(9002076,0)),U,4)'=3 D SET(9002076) S ERROR=2,ERRLIST(9002076)=""
  1.  I $P($G(^DD(9002077,0)),U,4)'=2 D SET(9002077) S ERROR=2,ERRLIST(9002077)=""
  1.  I $P($G(^DD(9002078,0)),U,4)'=2 D SET(9002078) S ERROR=2,ERRLIST(9002078)=""
  1.  I $P($G(^DD(9002079,0)),U,4)'=15 D SET(9002079) S ERROR=2,ERRLIST(9002079)=""
  1.  I $P($G(^DD(9002080,0)),U,4)'=50 D SET(9002080) S ERROR=2,ERRLIST(9002080)=""
  1.  Q
  1.  ;
  1.  ;SET INSTALL GLOBAL WITH INFO
  1. SET(NUM) ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"WARNING",$ZN,"CHS BAD DD INSTALL",NUM)=NOW
  1.  Q
  1. END ;
  1.  ;
  1.  D KTMP,NOW^%DTC
  1.  W !!,"CHS 3.1 Post-Init Complete ",$$FMTE^XLFDT(%)
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"CHS INSTALL","STATUS","INSTALL FINISHED")=NOW
  1.  ;
  1. MAIL ;
  1.  S ERROR=0
  1.  D START^ACHSPOSM(ERROR)    ;NO ERROR
  1.  Q
  1.  ;
  1.  ;KILL TEMP DATA GLOBALS
  1. KTMP ;
  1.  K ^TMP($J,"DEN"),^TMP($J,"FAC"),^TMP($J,"DEF"),^TMP($J,"MPRI")
  1.  Q
  1.  ;
  1. ERROR S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"ERROR TRAP CALLED")=""
  1.  G ^%ET
  1.  Q
  1.  ;
  1.  ;GO THRU ACHS FILES AND PULL CPT POINTERS. DELETE THOSE THAT POINT TO
  1.  ;CPT ENTRIES WITH THE SECOND PIECE OF THE ZERO NODE ="unknown"
  1. PULLCPT ;
  1.  S ACHSVERS="V"_$P($T(+2),";",3)
  1.  S U="^"
  1.  D DOCCPT    ;PULL CPTs FROM 'CHS FACILITY'
  1.  D DENCPT    ;PULL CPTs FROM 'CHS DENIAL DATA'
  1.  D DEFCPT    ;PULL CPTs FROM 'CHS DEFERRED SERVICES DATA'
  1.  ;D CLEANUP   ;CLEANUP ENTRIES IN ^ICPT WITH "unknown" IN SECOND
  1.  ;            PIECE OFNODE 0
  1.  Q
  1.  ;
  1.  ;GO THROUGH 'CHS FACILITY' FILE AND PULL CPT POINTERS
  1. DOCCPT ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DOCCPT^"_$ZN,"ENTERED")=NOW
  1.  ;
  1.  S CPTCNT=0
  1.  S FACILITY=0
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .;
  1.  .S DOCUMENT=0
  1.  .F DOCCNT=1:1 S DOCUMENT=$O(^ACHSF(FACILITY,"D",DOCUMENT)) Q:+DOCUMENT=0  D
  1.  ..;W !,DOCUMENT
  1.  ..S CPTMULT=0
  1.  ..F  S CPTMULT=$O(^ACHSF(FACILITY,"D",DOCUMENT,11,CPTMULT)) Q:+CPTMULT=0  D
  1.  ...S CPTINFO=$G(^ACHSF(FACILITY,"D",DOCUMENT,11,CPTMULT,0))
  1.  ...Q:CPTINFO=""!(CPTINFO'[("ICPT("))
  1.  ...S CODE=$P($P(CPTINFO,";"),U)
  1.  ...;
  1.  ...;IS THIS A BAD CHS CPT ENTRY?
  1.  ...;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
  1.  ...;Q:$P($G(^ICPT(CODE,0)),U,2)'="unknown"   ;NO THEN QUIT
  1.  ...Q:$P($$CPT^ICPTCOD(CODE),U,3)'="unknown"   ;NO THEN QUIT
  1.  ...S CPTCNT=CPTCNT+1   ;NUMBER OF CPT ENTRIES IN THE CHS GLOBAL
  1.  ...S DA(2)=FACILITY
  1.  ...S DA(1)=DOCUMENT
  1.  ...S DA=CPTMULT
  1.  ...S DIK="^ACHSF("_FACILITY_",""D"","_DA(1)_",11,"
  1.  ...D ^DIK
  1.  ...;K ^ACHSF(FACILITY,"D",DOCUMENT,11,CPTMULT)
  1.  ...;K ^ACHSF(FACILITY,"D",DOCUMENT,11,"B",$P(CPTINFO,U))
  1.  ...;S NUMENTRY=$P($G(^ACHSF(FACILITY,"D",DOCUMENT,11,0)),U,4)
  1.  ...;S NUMENTRY=NUMENTRY-1
  1.  ...;S $P(^ACHSF(FACILITY,"D",DOCUMENT,11,0),U,4)=NUMENTRY 
  1.  ;
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DOCCPT^"_$ZN,"FINISHED")=NOW
  1.  S ^ACHSINST(ACHSVERS,"DOCCPT^"_$ZN,"BAD CPT IN ^ACHSF")=CPTCNT
  1.  ;
  1.  Q
  1.  ;
  1.  ;NOW GET CPTs FROM 'CHS DEFERRED SERVICES DATA'
  1.  ;
  1. DEFCPT ;
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DEFCPT^"_$ZN,"ENTERED")=NOW
  1.  ;
  1.  S DEFCNT=0
  1.  S FACILITY=0
  1.  F  S FACILITY=$O(^ACHSDEF(FACILITY)) Q:+FACILITY=0  D
  1.  .S DEFDOC=0
  1.  .F  S DEFDOC=$O(^ACHSDEF(FACILITY,"D",DEFDOC)) Q:+DEFDOC=0  D
  1.  ..S MULT=0
  1.  ..F  S MULT=$O(^ACHSDEF(FACILITY,"D",DEFDOC,300,MULT)) Q:+MULT=0  D
  1.  ...S DEFCPT=$P($G(^ACHSDEF(FACILITY,"D",DEFDOC,300,MULT,0)),U)
  1.  ...Q:DEFCPT=""
  1.  ...;IS THIS POINTING TO A BAD CHS CPT ENTRY?
  1.  ...;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
  1.  ...;Q:$P($G(^ICPT(DEFCPT,0)),U,2)'="unknown"
  1.  ...Q:$P($$CPT^ICPTCOD(DEFCPT),U,3)'="unknown"
  1.  ...S DEFCNT=DEFCNT+1
  1.  ...S DA(2)=FACILITY
  1.  ...S DA(1)=DEFDOC
  1.  ...S DA=MULT
  1.  ...S DIK="^ACHSF("_FACILITY_",""D"","_DA(1)_",300,"
  1.  ...D ^DIK
  1.  ...;K ^ACHSDEF(FACILITY,"D",DEFDOC,300,MULT)
  1.  ...;K ^ACHSDEF(FACILITY,"D",DEFDOC,300,"B",DEFCPT)
  1.  ...;S NUMENTRY=$P($G(^ACHSDEF(FACILITY,"D",DEFDOC,300,0)),U,4)
  1.  ...;S NUMENTRY=NUMENTRY-1
  1.  ...;S $P(^ACHSDEF(FACILITY,"D",DEFDOC,300,0),U,4)=NUMENTRY 
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DEFCPT^"_$ZN,"FINISHED")=NOW
  1.  S ^ACHSINST(ACHSVERS,"DEFCPT^"_$ZN,"BAD CPT IN ^ACHSDEF")=DEFCNT
  1.  ;
  1.  Q
  1.  ;
  1.  ;NOW GET CPTs FROM 'CHS DENIAL DATA' FILE
  1. DENCPT ;
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DENCPT^"_$ZN,"ENTERED")=NOW
  1.  ;
  1.  S DENCNT=0
  1.  S FACILITY=0
  1.  F  S FACILITY=$O(^ACHSDEN(FACILITY)) Q:+FACILITY=0  D
  1.  .S DENDOC=0
  1.  .F  S DENDOC=$O(^ACHSDEN(FACILITY,"D",DENDOC)) Q:+DENDOC=0  D
  1.  ..S MULT=0
  1.  ..F  S MULT=$O(^ACHSDEN(FACILITY,"D",DENDOC,MULT)) Q:+MULT=0  D
  1.  ...S DENCPT=$P($G(^ACHSDEN(FACILITY,"D",DENDOC,700,MULT,0)),U)
  1.  ...Q:DENCPT=""
  1.  ...;
  1.  ...;IS THIS A BAD CHS CPT ENTRY?
  1.  ...;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
  1.  ...;Q:$P($G(^ICPT(DENCPT,0)),U,2)'="unknown"
  1.  ...Q:$P($$CPT^ICPTCOD(DENCPT),U,3)'="unknown"
  1.  ...S DENCNT=DENCNT+1
  1.  ...S DA(2)=FACILITY
  1.  ...S DA(1)=DENDOC
  1.  ...S DA=MULT
  1.  ...S DIK="^ACHSF("_FACILITY_",""D"","_DA(1)_",700,"
  1.  ...D ^DIK
  1.  ...;K ^ACHSDEN(FACILITY,"D",DENDOC,700,MULT)
  1.  ...;K ^ACHSDEN(FACILITY,"D",DENDOC,700,"B",DENCPT)
  1.  ...;S NUMENTRY=$P($G(^ACHSDEN(FACILITY,"D",DENDOC,700,0)),U,4)
  1.  ...;S NUMENTRY=NUMENTRY-1
  1.  ...;S $P(^ACHSDEN(FACILITY,"D",DENDOC,700,0),U,4)=NUMENTRY 
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DENCPT^"_$ZN,"FINISHED")=NOW
  1.  S ^ACHSINST(ACHSVERS,"DENCPT^"_$ZN,"BAD CPT IN ^ACHSDEN")=DENCNT
  1.  ;
  1.  Q
  1.  ;
  1.  ;CLEANUP CPT "unknown" ENTRIES
  1. CLEANUP ;
  1.  ;
  1.  S CPTCODE=0
  1.  F  S CPTCODE=$O(^ICPT(CPTCODE)) Q:+CPTCODE=0  D
  1.  .;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
  1.  .;Q:$P($G(^ICPT(CPTCODE,0)),U,2)'="unknown"
  1.  .Q:$P($$CPT^ICPTCOD(CPTCODE),U,3)'="unknown"
  1.  .S DIK="^ICPT("
  1.  .S DA=CPTCODE
  1.  .D ^DIK
  1.  .;
  1.  Q
  1.  ;
  1. OPTS ;
  1.  ;;ACHSDENADD
  1.  ;;ACHSDENDELETE
  1.  ;;ACHSDENDOCUMENT
  1.  ;;ACHSDENEDIT
  1.  ;;ACHSDENLETTER
  1.  ;;ACHSDENMENU
  1.  ;;ACHSDENPARM
  1.  ;;ACHSDENPARMADDREA
  1.  ;;ACHSDENPARMAMT
  1.  ;;ACHSDENPARMBOT
  1.  ;;ACHSDENPARMFAC
  1.  ;;ACHSDENPARMHEAD
  1.  ;;ACHSDENPARMLOF
  1.  ;;ACHSDENPARMMID
  1.  ;;ACHSDENPARMNUMS
  1.  ;;ACHSDENPARMREA
  1.  ;;ACHSDENPARMSIG
  1.  ;;ACHSDENPARMUNMET
  1.  ;;ACHSDENPVDRLIST
  1.  ;;ACHSDENPVDRLISTNOT
  1.  ;;ACHSDENREASONS
  1.  ;;ACHSDENREP1
  1.  ;;ACHSDENREPMENU
  1.  ;;ACHSDENRPTHQ1
  1.  ;;ACHSDENSTATS
  1.  ;;ACHSDENUNMET