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

APCD2010.m

Go to the documentation of this file. 
  1. APCD2010 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 10 [ 03/11/05  9:09 AM ]
  1.  ;;2.0;IHS RPMS/PCC Data Entry;**10**;MAR 09, 1999
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  I '$$INSTALLD("AUPN*99.1*18") D SORRY(2)
  1.  I '$$INSTALLD("APCD*2.0*9") D SORRY(2)
  1.  I '$$INSTALLD("AICD*3.51*7") D SORRY(2)
  1.  I '$D(^DIC(9.4,"C","LEX")) D MES^XPDUTL($$CJ^XLFSTR("Lexicon is *NOT* installed.",IOM)) D SORRY(2)
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;EP
  1.  F DA=1:1:200 S DIK="^APCDERR(" D ^DIK
  1.  K DA,DIK
  1.  F DA=1:1:200 S DIK="^APCDINPT(" D ^DIK
  1.  K DA,DIK
  1.  S X=$O(^DIE("B","APCD WC (ADD)",0))
  1.  I X S ^DIE(X,"ROU")=""
  1.  S X=$O(^DIE("B","APCD WC (MOD)",0))
  1.  I X S ^DIE(X,"ROU")=""
  1. EDUC ;
  1.  ;EDUCATION TOPICS CHANGES PER CHRIS SADDLER
  1.  S DA=$O(^APCDEDCV("C","L",0)) I DA S DIE="^APCDEDCV(",DR=".01///LITERATURE" D ^DIE
  1.  K DA,DIE,DR
  1.  S DA=$O(^APCDEDCV("C","TE",0)) I DA S DIE="^APCDEDCV(",DR=".01///TESTS" D ^DIE
  1.  K DA,DR,DIE
  1.  Q
  1. POST ;
  1.  ;
  1. WCE ;
  1.  D ^XBFMK
  1.  I '$D(^APCDTKW("B","CRFT")) D
  1.  .S X="CRFT",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""CRFT"";.06///CRAFFT;.07///0;.08///1;.09///9000010.01"
  1.  .K DD,D0,DO
  1.  .D FILE^DICN
  1.  .I Y=-1 W !!,"Adding CRFT mnemonic failed." H 4
  1.  I '$D(^APCDTKW("B","AUDT")) D
  1.  .S X="AUDT",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""AUDT"";.06///AUDIT;.07///0;.08///1;.09///9000010.01"
  1.  .K DD,D0,DO
  1.  .D FILE^DICN
  1.  .I Y=-1 W !!,"Adding AUDT mnemonic failed." H 4
  1.   I '$D(^APCDTKW("B","PHQ2")) D
  1.  .S X="PHQ2",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PHQ2"";.06///PHQ2;.07///0;.08///1;.09///9000010.01"
  1.  .K DD,D0,DO
  1.  .D FILE^DICN
  1.  .I Y=-1 W !!,"Adding PHQ2 mnemonic failed." H 4
  1.   I '$D(^APCDTKW("B","PHQ9")) D
  1.  .S X="PHQ9",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PHQ9"";.06///PHQ9;.07///0;.08///1;.09///9000010.01"
  1.  .K DD,D0,DO
  1.  .D FILE^DICN
  1.  .I Y=-1 W !!,"Adding PHQ2 mnemonic failed." H 4
  1.  I '$D(^APCDTKW("B","HCPT")) D
  1.  .S X="HCPT",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD HCPT];.06///Historical CPT;.07///0;.08///0;.09///9000010.18;.15///71;.16///71"
  1.  .K DD,D0,DO
  1.  .D FILE^DICN
  1.  .I Y=-1 W !!,"Adding HCPT mnemonic failed." H 4
  1.  K DIC,DD,D0,DO
  1.  S X=$O(^DIE("B","APCD WC (ADD)",0))
  1.  I X S ^DIE(X,"ROU")="^APCDTWC"
  1.  S X=$O(^DIE("B","APCD WC (MOD)",0))
  1.  I X S ^DIE(X,"ROU")="^APCDTWC"
  1.  ;
  1.  D ^APCDBUL0
  1.  Q
  1. INSTALLD(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
  1.  ; APCDSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW APCDY,DIC,X,Y
  1.  S X=$P(APCDSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(APCDSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(APCDSTAL,"*",3)
  1.  D ^DIC
  1.  S APCDY=Y
  1.  D IMES
  1.  Q $S(APCDY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCDSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q