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

APSPEC20.m

Go to the documentation of this file. 
  1. APSPEC20 ;IHS/CIA/PLS - APSP ENVIRONMENT CHECK ROUTINE ;16-Oct-2015 08:10;DU
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1020**;Sep 23, 2004;Build 7
  1.  ;
  1. ENV ;EP
  1.  ;
  1.  S X=$$GET1^DIQ(200,DUZ,.01)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_", Patch 1020.",IOM)
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0  ; Suppress the Disable options and Move routines prompts
  1.  S XPDABORT=0
  1.  I 'XPDABORT D
  1.  .W !!,"All requirements for installation have been met...",!
  1.  E  D
  1.  .W !!,"Unable to continue with the installation...",!
  1.  Q
  1.  ;
  1. MES(TXT,QUIT) ;EP
  1.  D BMES^XPDUTL("  "_$G(TXT))
  1.  S:$G(QUIT) XPDABORT=QUIT
  1.  Q
  1.  ;
  1. PRE ;EP - Pre-init
  1.  Q
  1. RENXPAR(OLD,NEW) ; Rename parameter
  1.  N IEN,FDA,FIL
  1.  S FIL=8989.51
  1.  Q:$$FIND1^DIC(FIL,,"X",NEW)  ; New name already exists
  1.  S IEN=$$FIND1^DIC(FIL,,"X",OLD)
  1.  Q:'IEN  ; Old name doesn't exist
  1.  S FDA(FIL,IEN_",",.01)=NEW
  1.  D FILE^DIE("E","FDA")
  1.  Q
  1.  ;
  1. REMXPAR(PAR) ;Remove values stored for a given parameter
  1.  N PIEN,ENT,INT,VIEN,DIK,DA
  1.  S PIEN=$O(^XPAR(8989.51,"B",PAR,0))
  1.  Q:'PIEN
  1.  S ENT=0 F  S ENT=$O(^XPAR(8989.5,"AC",PIEN,ENT)) Q:ENT=""  D  ;Entity
  1.  .S INT=0 F  S INT=$O(^XPAR(8989.5,"AC",PIEN,ENT,INT)) Q:INT=""  D  ;Instance
  1.  ..S DA=0 F  S DA=$O(^XPAR(8989.5,"AC",PIEN,ENT,INT,DA)) Q:'DA  D  ;Value IEN
  1.  ...S DIK="^XTV(8989.5," D ^DIK
  1.  Q
  1. POST ;EP
  1.  Q
  1.  ; Create "B" xref for ZipCodes
  1. ZCXREF ;EP
  1.  D MES("Building ZipCode Proximity crossreference (a '.' represents 100 entries)")
  1.  N ZC
  1.  S ZC=0 F  S ZC=$O(^APSPZCPX(ZC)) Q:'ZC  D
  1.  .D ONEZC(ZC)
  1.  .W:'(ZC#100) "."
  1.  Q
  1.  ;
  1. ONEZC(ZC) ;EP
  1.  N LP,DAT
  1.  K ^APSPZCPX(ZC,1,"B")
  1.  S LP=0 F  S LP=$O(^APSPZCPX(ZC,1,LP)) Q:'LP  D
  1.  .S DAT=^APSPZCPX(ZC,1,LP,0)
  1.  .S ^APSPZCPX(ZC,1,"B",$P(DAT,U,2),LP)=""
  1.  Q
  1.  ; Lock down and mark all POV related fields and parameters
  1. LOCKPOV ;EP-
  1.  D UPDPAR("SYS","APSP POV CACHE")
  1.  Q
  1.  ;
  1. UPDPAR(ENT,PARAM,VAL,LCK) ;EP-
  1.  N IEN
  1.  S IEN=$O(^XTV(8989.51,"B",PARAM,0))
  1.  Q:'IEN
  1.  S $P(^XTV(8989.51,IEN,0),U,6)=0
  1.  D:$G(VAL)'="" EN^XPAR(ENT,PARAM,,VAL)
  1.  S $P(^XTV(8989.51,IEN,0),U,6)=$G(LCK,1)
  1.  Q
  1. PAR ;Set system level for new parameter
  1.  D EN^XPAR("SYS","APSP RXNORM NDC LOOKUP",,"L")
  1.  Q
  1. ADDMENU ;Add items to a menu
  1.  D REGMENU^BEHUTIL("APSP MU MENU",,"MU","APSP MAIN MENU")
  1.  ;D REGMENU^BEHUTIL("APSPRCUI UPDATE",,"RXN","APSP MAIN MENU")
  1.  ;D REGMENU^BEHUTIL("APSP DRUGS W/O RXNORM",,"WOR","APSP MAIN MENU")
  1.  ;D REGMENU^BEHUTIL("APSP REMAP RXNORM",,"REM","APSP MAIN MENU")
  1.  Q
  1.  ; Add given namespace to Application
  1. AAPPGRP(FILE,NMSP) ;EP
  1.  N FDA,IEN,ERR
  1.  Q:'$G(FILE)!('$L(NMSP))
  1.  S FDA(1.005,"?+1,"_FILE_",",.01)=NMSP
  1.  D UPDATE^DIE("","FDA","IEN","ERR")
  1.  Q
  1.  ; Register a protocol to an extended action protocol
  1.  ; Input: P-Parent protocol
  1.  ;        C-Child protocol
  1.  ;     SEQ-Sequence Number
  1. REGPROT(P,C,SEQ,ERR) ;EP
  1.  N IENARY,PIEN,AIEN,FDA
  1.  D
  1.  .I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q
  1.  .S IENARY(1)=$$FIND1^DIC(101,"","",P)
  1.  .S AIEN=$$FIND1^DIC(101,"","",C)
  1.  .I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q
  1.  .S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
  1.  .S FDA(101.01,"?+2,"_IENARY(1)_",",3)=SEQ
  1.  .D UPDATE^DIE("S","FDA","IENARY","ERR")
  1.  ;Q:$Q $G(ERR)=""
  1.  Q
  1.  ; UnRegister a protocol from an extended action protocol
  1.  ; Input: P-Parent protocol
  1.  ;        C-Child protocol
  1. UREGPROT(P,C,ERR) ;EP-
  1.  N IENARY,PIEN,AIEN,FDA
  1.  D
  1.  .I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q
  1.  .S IENARY(1)=$$FIND1^DIC(101,"","",P)
  1.  .S AIEN=$$FIND1^DIC(101,"","",C)
  1.  .I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q
  1.  .S IENARY(2)=$$FIND1^DIC(101.01,","_IENARY(1)_",","",C)
  1.  .S FDA(101.01,IENARY(2)_","_IENARY(1)_",",.01)="@"
  1.  .D UPDATE^DIE("S","FDA","","ERR")
  1.  Q
  1. SETPKGV(PKG,VER) ;EP
  1.  N PIEN,FDA
  1.  S PIEN=$$FIND1^DIC(9.4,,,PKG)
  1.  Q:'PIEN
  1.  S FDA(9.4,PIEN_",",13)=VER
  1.  D UPDATE^DIE(,"FDA")
  1.  Q
  1.  ; Cleanup Drug File DD
  1. CLN50DD ;EP -
  1.  S DIU=50.03,DIU(0)="SD" D EN^DIU2
  1.  Q
  1.  ; Fix Out of Order Message and lock with APSP Key
  1. OFOMSG(OPT,MSG,KEY) ;
  1.  N IEN,VAL,FDA,KIEN
  1.  S IEN=$$FIND1^DIC(19,,"X",OPT)
  1.  S KIEN=$$FIND1^DIC(19.1,,"X",KEY)
  1.  I IEN D
  1.  .S VAL=$S($L($G(MSG)):MSG,1:"Not used in IHS")
  1.  .S FDA(19,IEN_",",2)=VAL
  1.  .S:KIEN FDA(19,IEN_",",3)=KIEN
  1.  .D FILE^DIE("K","FDA")
  1.  Q
  1.  ; Cleanup PCC Link in NVA node
  1. CLNNVA ;EP -
  1.  N DFN,IEN,FDA,NVAERR
  1.  S DFN=0 F  S DFN=$O(^PS(55,"APCC","+1",DFN)) Q:'DFN  D
  1.  .S IEN=0 F  S IEN=$O(^PS(55,"APCC","+1",DFN,IEN)) Q:'IEN  D
  1.  ..S FDA(55.05,IEN_","_DFN_",",9999999.11)="@"
  1.  D:$D(FDA) UPDATE^DIE("","FDA",,"NVAERR")
  1.  W:$G(DIERR) $G(NVAERR("DIERR",1,"TEXT",1))
  1.  Q
  1. FIXNODE ;EP
  1.  N IEN,NODE,INST,FN,FDA,IENS,ERR,DOSE,DISP,UNITS,UNIT,NOUN
  1.  S FN=9009033.912
  1.  S IEN=0 F  S IEN=$O(^APSPRREQ(IEN)) Q:'+IEN  D
  1.  .S INST=0 F  S INST=$O(^APSPRREQ(IEN,2,INST)) Q:'+INST  D
  1.  ..S IENS=INST_","_IEN_","
  1.  ..S NODE=$G(^APSPRREQ(IEN,2,INST,0))
  1.  ..Q:$D(^APSPRREQ(IEN,2,INST,1))     ;Quit if already converted
  1.  ..S DOSE=$P(NODE,U,1)
  1.  ..S FDA(FN,IENS,1.1)=DOSE           ;Dosage ordered
  1.  ..S DISP=$P(NODE,U,2)
  1.  ..S FDA(FN,IENS,1.2)=DISP           ;Dispense per dose
  1.  ..S UNITS=$P(NODE,U,3)
  1.  ..S UNIT=$$GET1^DIQ(50.607,UNITS,.01)
  1.  ..S FDA(FN,IENS,1.3)=UNIT           ;Units
  1.  ..S NOUN=$P(NODE,U,4)
  1.  ..S FDA(FN,IENS,1.4)=NOUN           ;noun
  1.  ..S FDA(FN,IENS,1.5)=$P(NODE,U,5)   ;duration
  1.  ..S FDA(FN,IENS,1.6)=$P(NODE,U,6)   ;conjunction
  1.  ..S FDA(FN,IENS,1.7)=$P(NODE,U,7)   ;route
  1.  ..S FDA(FN,IENS,1.8)=$P(NODE,U,8)   ;schedule
  1.  ..S FDA(FN,IENS,1.9)=$P(NODE,U,9)   ;route
  1.  ..;S FDA(FN,IENS,.01)=DOSE_"&"_UNIT_"&"_DISP_"&"_NOUN_"&"_DOSE_UNIT
  1.  ..D UPDATE^DIE("","FDA","IENS","ERR")
  1.  ..S ^APSPRREQ(IEN,2,INST,0)=DOSE_"&"_UNIT_"&"_DISP_"&"_NOUN_"&"_DOSE_UNIT
  1.  ..K FDA,IENS,ERR
  1.  ..K ^APSPRREQ(IEN,2,"B",DOSE,INST)
  1.  Q
  1.  ; Fix VMed entries lacking Date Discontinued
  1. FIXVMEDD(DAYS) ;EP -
  1.  N RX,BDT,EDT,FDT,VMED,ACT
  1.  S EDT=$$DT^XLFDT()
  1.  S BDT=$$FMADD^XLFDT(EDT,-$G(DAYS,730))
  1.  S FDTLP=BDT-.01
  1.  F  S FDTLP=$O(^PSRX("AD",FDTLP)) Q:'FDTLP!(FDTLP>EDT)  D
  1.  .S RX=0
  1.  .F  S RX=$O(^PSRX("AD",FDTLP,RX)) Q:'RX  D
  1.  ..Q:$G(^PSRX(RX,"STA"))'=15        ;status not Discontinued (Edit)
  1.  ..S VMED=+$G(^PSRX(RX,999999911))
  1.  ..Q:'VMED
  1.  ..Q:$P($G(^AUPNVMED(VMED,0)),U,8)  ;already marked as discontinued
  1.  ..;Check last activity node for a discontinued type
  1.  ..S ACT=$P($G(^PSRX(RX,"A",0)),U,4)
  1.  ..Q:'ACT
  1.  ..S ACT=$G(^PSRX(RX,"A",ACT,0))
  1.  ..I $P(ACT,U,2)="C" D
  1.  ...S $P(^AUPNVMED(VMED,0),U,8)=$P(+ACT,".")
  1.  Q
  1.  ; Send Quantity Qualifier MailMan message
  1. MM ;EP-
  1.  N LP,XMTEXT,XMY,XMSUB,XMDUZ,DA,DIFROM,CNT,DATA
  1.  N QQARY,DNM,QQNM,STR,X
  1.  K ^TMP("DATA",$J)
  1.  F LP=0:1 S X=$P($T(IENS+LP),";;",2) Q:'$L(X)  D
  1.  .D SEARCH(+X)
  1.  I $D(^TMP("DATA",$J)) D
  1.  .S DATA=$NA(^TMP("APSP1016Z",$J))
  1.  .K @DATA
  1.  .S XMTEXT="^TMP(""APSP1016Z"",$J,"
  1.  .S XMDUZ="NDF MANAGER"
  1.  .S XMSUB="DRUGS ASSOCIATED WITH INACTIVATED QUANTITY QUALIFIERS"
  1.  .D BLDTXT
  1.  .S CNT=7
  1.  .S DNM="" F  S DNM=$O(^TMP("DATA",$J,DNM)) Q:DNM=""  D
  1.  ..S QQNM="" F  S QQNM=$O(^TMP("DATA",$J,DNM,QQNM)) Q:QQNM=""  D
  1.  ...S X=^TMP("DATA",$J,DNM,QQNM)
  1.  ...S STR=DNM,$E(STR,52)=+X,$E(STR,59)=QQNM
  1.  ...S CNT=CNT+1
  1.  ...S @DATA@(CNT)=STR
  1.  .S DA=0 F  S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA  S XMY(DA)=""
  1.  .S XMY("G.NDF DATA@"_^XMB("NETNAME"))=""
  1.  .D ^XMD
  1.  Q
  1.  ;
  1.  ;Add fixed text to message global
  1. BLDTXT ;EP-
  1.  S @DATA@(1)="The following entries in your DRUG file (#50) are associated with"
  1.  S @DATA@(2)="NCPDP Quantity Qualifiers in the APSP NCPDP Control Codes file."
  1.  S @DATA@(3)="It is critical that you rematch these products immediately so that"
  1.  S @DATA@(4)="the Surescripts interface will continue to work without errors."
  1.  S @DATA@(5)=""
  1.  S @DATA@(6)="DRUG                                               IEN    QTY QUALIFIER"
  1.  S @DATA@(7)=""
  1.  Q
  1.  N DIEN,DRGQQ
  1.  S DIEN=0 F  S DIEN=$O(^PSDRUG(DIEN)) Q:'DIEN  D
  1.  .S DRGQQ=+$P($G(^PSDRUG(DIEN,9999999.145)),U)
  1.  .Q:DRGQQ'=QQ
  1.  .S ^TMP("DATA",$J,$$GET1^DIQ(50,DIEN,.01),$$GET1^DIQ(9009033.7,QQ,.01))=DIEN_U_QQ_U_$$GET1^DIQ(9009033.7,QQ,1)
  1.  Q
  1. IENS ;;147
  1.  ;;150
  1.  ;;154
  1.  ;;155
  1.  ;;167
  1.  ;;