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

APCL3024.m

Go to the documentation of this file. 
  1. APCL3024 ; IHS/CMI/LAB - environment check ;
  1.  ;;3.0;IHS PCC REPORTS;**24**;FEB 05, 1997
  1.  ;
  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 $$VERSION^XPDUTL("BJPC")'="2.0" W !,"version 2.0 of BJPC is required" D SORRY(2)
  1.  I $$VERSION^XPDUTL("BGP")'="9.0" W !,"version 9.0 of BGP is required" D SORRY(2)
  1.  I '$$INSTALLD("APCL*3.0*23") D SORRY(2)
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;
  1.  Q
  1. POST ;
  1. OPTIONS ;
  1.  S X=$$ADD^XPDMENU("APCL M OTHER REPORTS","APCL EDIT SURV ILI STOP DATE","USSD")
  1.  I 'X W "Attempt to add APCL EDIT SURV ILI STOP DATE option failed.." H 3
  1.  ;S DA=$O(^APCLCNTL("B","ILI STOP DATE",0))
  1.  ;I 'DA W !!,"ILI CONTROL FILE ENTRY MISSING.  NOTIFY PROGRAMMER." K DA Q
  1.  ;I $P(^APCLCNTL(DA,0),U,3)>3100801 G POST1
  1.  ;S DIE="^APCLCNTL(",DR=".03////3100801"
  1.  ;D ^DIE
  1.  ;K DIE,DA
  1. POST1 ;
  1.  D CLTAX
  1.  D ^APCL23
  1.  D ZISH
  1.  S X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCL SURVEILLANCE ILI TEMPLATE","ILI")
  1.  I 'X W "Attempt to add SURVEILLANCE ILI report option failed.." H 3
  1.  S X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCL SURVEILLANCE AGG REPORT","AGIL")
  1.  I 'X W "Attempt to add aggregate report option failed." H 3
  1.  D MEDTAX
  1.  Q
  1. MEDTAX ;
  1.  S ATXFLG=1
  1.  S APCLX="FLU ANTIVIRAL MEDS",APCLTAX="",APCLNDCT="" D DRUG1 D
  1.  .S APCLTX=$O(^ATXAX("B","FLU ANTIVIRAL MEDS",0))
  1.  .Q:'APCLTX
  1.  .S A=0,B="" F  S A=$O(^ATXAX(APCLTX,21,A)) Q:A'=+A  S B=A
  1.  .S APCLC=B
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P(^PSDRUG(J,0),U,1) I $$UP^XLFSTR(C)["OSELTAMIVIR"!($$UP^XLFSTR(C)["ZANAMIVIR") D
  1.  ..Q:$D(^ATXAX(APCLTX,21,"B",J))
  1.  ..S APCLC=APCLC+1,^ATXAX(APCLTX,21,APCLC,0)=J_U_J,^ATXAX(APCLTX,21,0)="^9002226.02101A^"_APCLC_U_APCLC
  1.  .S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1. DRUG1 ;
  1.  W !,"Creating ",APCLX," Taxonomy..."
  1.  S APCLTX=$O(^ATXAX("B",APCLX,0))
  1.  I 'APCLTX D  Q:Y=-1
  1.  .S X=APCLX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  .I Y=-1 W !!,"ERROR IN CREATING ",APCLX," TAX" Q
  1.  .S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)=APCLX,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=173,$P(^(0),U,13)=0,$P(^(0),U,15)=50,^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
  1.  S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
  1.  I $G(APCLTAX)]"" D
  1.  .S A=0,B="" F  S A=$O(^ATXAX(APCLTX,21,A)) Q:A'=+A  S B=A
  1.  .S APCLC=B
  1.  .S ^ATXAX(APCLTX,21,0)="^9002226.02101A^"_B_U_B
  1.  .S Z=$O(^ATXAX("B",APCLTAX,0))
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P($G(^PSDRUG(J,0)),U,2) I C]"",$D(^ATXAX(Z,21,"B",C)) D
  1.  ..Q:$D(^ATXAX(APCLTX,21,"B",J))
  1.  ..S APCLC=APCLC+1,^ATXAX(APCLTX,21,APCLC,0)=J_U_J
  1.  I $G(APCLNDCT)]"" D
  1.  .S A=0,B="" F  S A=$O(^ATXAX(APCLTX,21,A)) Q:A'=+A  S B=A
  1.  .S APCLC=B
  1.  .S ^ATXAX(APCLTX,21,0)="^9002226.02101A^"_B_U_B
  1.  .S Z=$O(^ATXAX("B",APCLNDCT,0))
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P($G(^PSDRUG(J,2)),U,4) I C]"",$D(^ATXAX(Z,21,"B",C)) D
  1.  ..Q:$D(^ATXAX(APCLTX,21,"B",J))
  1.  ..S APCLC=APCLC+1,^ATXAX(APCLTX,21,APCLC,0)=J_U_J
  1.  S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. ZISH ;create entry in ZISH SEND PARAMETERS file
  1.  D ^XBFMK K DIADD,DLAYGO,DIC,DD,D0,DO
  1.  Q:$D(^%ZIB(9888888.93,"B","SURVEILLANCE ILI SEND"))
  1.  S APCLY=0 F  S APCLY=$O(^%ZIB(9888888.93,"B","SURVEILLANCE ILI SEND",0)) Q:APCLY'=+APCLY  D
  1.  .I APCLY S DA=APCLY,DIK="^%ZIB(9888888.93," D ^DIK K DA,DIK
  1.  S X="SURVEILLANCE ILI SEND",DIC(0)="L",DIC="^%ZIB(9888888.93," D FILE^DICN
  1.  I Y=-1 W !!,"error creating ZISH SEND PARAMETERS entry" Q
  1.  S DA=+Y,DIE="^%ZIB(9888888.93,",DR=".02///QUOVADX-IE.IHS.GOV;.03///fludata;.04///etgx7h;.06///-u;.07///B;.08///sendto"
  1.  D ^DIE
  1.  I $D(Y) W !!,"error updating ZISH SEND PARAMETERS entry" Q
  1.  Q
  1.  ;
  1. CLTAX ;
  1.  S ATXFLG=1
  1.  Q:$D(^ATXAX("B","SURVEILLANCE ILI CLINICS"))
  1.  W !,"Creating Surveillance ILI Clinics taxonomy..."
  1.  S APCLDA=0 S APCLDA=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",APCLDA)) I APCLDA S DA=APCLDA S DIK="^ATXAX(" D ^DIK K DA,DIK
  1.  S X="SURVEILLANCE ILI CLINICS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  I Y=-1 W !!,"ERROR IN CREATING SURVEILLANCE ILI CLINICS TAX" Q
  1.  S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)="SURVEILLANCE ILI CLINICS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=172,$P(^(0),U,13)=0,$P(^(0),U,15)=40.7,^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
  1.  D ^XBFMK K DIADD,DLAYGO S APCLTEXT="CLINICS" F APCLX=1:1 S X=$P($T(@APCLTEXT+APCLX),";;",2) Q:X=""  S Y=$O(^DIC(40.7,"C",X,0)) I Y D
  1.  .S ^ATXAX(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
  1.  .Q
  1.  S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. INSTALLD(APCLSTAL) ;EP - Determine if patch APCLSTAL was installed, where
  1.  ; APCLSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW APCLY,DIC,X,Y
  1.  S X=$P(APCLSTAL,"*",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(APCLSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(APCLSTAL,"*",3)
  1.  D ^DIC
  1.  S APCLY=Y
  1.  D IMES
  1.  Q $S(APCLY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCLSTAL_""" 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
  1. CLINICS ;
  1.  ;;30
  1.  ;;10
  1.  ;;12
  1.  ;;13
  1.  ;;20
  1.  ;;24
  1.  ;;28
  1.  ;;57
  1.  ;;70
  1.  ;;80
  1.  ;;89
  1.  ;;01
  1.  ;;06
  1.  ;;