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

APSPPCC1.m

Go to the documentation of this file. 
  1. APSPPCC1 ;IHS/CIA/PLS - PCC Hook for Pharmacy Package - Continued ;04-Jun-2014 14:48;DU
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1003,1005,1007,1009,1010,1013,1017,1018**;Sep 23, 2004;Build 21
  1.  ; Modified - IHS/MSC/PLS - 02/05/08 - POV API modified
  1.  ;                          08/25/10 - SET+1
  1.  ;                          02/10/11 - EN and new EN1 EP
  1.  ; Prompt and store POV value in APSP POV CACHE parameter
  1. EN(DFN,RXIEN,SUS) ;EP
  1.  ;Q  ;IHS/MSC/PLS - 05/16/2013 - POV Functionality disabled per CR368
  1.  ;IHS/MSC/PLS - 06/03/2014 - Added hard set of ICD code into XPAR parameter
  1.  I $$GET1^DIQ(9009033,+$G(PSOSITE),405,"I") D
  1.  .N POV,RFIEN,IMP
  1.  .S RFIEN=$O(^PSRX(RXIEN,1,$C(1)),-1)
  1.  .Q:'$G(SUS)&('RFIEN)
  1.  .Q:$L($$GET^XPAR("SYS","APSP POV CACHE",+RXIEN_","_+RFIEN))  ; already have a POV stored
  1.  .I $$VERSION^XPDUTL("AICD")<4.0 S POV="V68.1"
  1.  .E  D
  1.  ..S IMP=$$IMP^ICDEX("10D",DT)
  1.  ..I DT<IMP S POV="V68.1"
  1.  ..E  S POV="Z76.0"
  1.  .D SET(RXIEN,RFIEN,POV)
  1.  Q
  1.  I $$GET1^DIQ(9009033,+$G(PSOSITE),405,"I") D
  1.  .W !!,"Processing POV entry for prescription...",!
  1.  .D EN1
  1.  E  I $G(SUS) D
  1.  .Q:'$$GET1^DIQ(9009033,+$G(PSOSITE),402,"I")
  1.  .W !!,"Processing POV entry for suspense...",!
  1.  .D EN1
  1.  E  I $$GET1^DIQ(9009033,+$G(PSOSITE),315,"I") D
  1.  .Q:'RFIEN  ; Must have a refill
  1.  .Q:'$$CONFIRM("Is this a Pharmacy Only Visit (Paperless refill)?",1)
  1.  .W !!,"Processing paperless refill...",!
  1.  .D EN1
  1.  Q
  1. EN1 ;EP - Prompt user
  1.  W !,"Rx# "_$P($G(^PSRX(RXIEN,0)),U,1),"  Drug:",$P($G(^PSDRUG(+$P($G(^PSRX(RXIEN,0)),U,6),0)),U),!
  1.  S POV=$$POV(RXIEN,RFIEN)
  1.  D SET(RXIEN,RFIEN,POV)
  1.  Q
  1.  ; Prompt and store POV value in cache
  1.  ; Input:  RXIEN - Prescription IEN
  1.  ;         RFIEN - Refill IEN under Prescription IEN
  1. POV(RXIEN,RFIEN) ;
  1.  N RXVMED,POV,VIS,CLININD,SIGN
  1.  S POV=""
  1.  ; Check for Indication Code - IHS/MSC/PLS - 02/05/08 - Added lookup of Sign/Indication Code if available.
  1.  S SIGN=$P($G(^PSRX(RXIEN,999999921)),U)
  1.  S CLININD=$P($G(^PSRX(RXIEN,999999921)),U,2)
  1.  I $L(CLININD) D  Q:$L(POV) POV
  1.  .W !,"Do you wish to use the Sign/Symptom associated with the prescription?",!
  1.  .S X=CLININD,DIC=80,DIC(0)="EMQ" D ^DIC
  1.  .I $G(Y)>0 D
  1.  ..S POV=$P(Y,U,2)_U_$$PRVNARR^APSPPCC($S($L(SIGN):SIGN,1:$$GET1^DIQ(80,+Y,3)))
  1.  ;
  1.  S RXVMED=$$GETVMED(RXIEN)
  1.  I 'RXVMED D
  1.  .S POV=$$ACTPROB(RXIEN)
  1.  .S:'$L(POV) POV=$$PROVNAR
  1.  E  D
  1.  .S VIS=+$$GET1^DIQ(9000010.14,RXVMED,.03,"I")
  1.  .I '$D(^AUPNVSIT(VIS,0)) D
  1.  ..S POV=$$ACTPROB(RXIEN)
  1.  ..S:'$L(POV) POV=$$PROVNAR
  1.  .E  I '$D(^AUPNVPOV("AD",VIS)) D
  1.  ..S POV=$$ACTPROB(RXIEN)
  1.  ..S:'$L(POV) POV=$$PROVNAR
  1.  .E  D
  1.  ..S POV=$$POVS(VIS)
  1.  ..S:'$L(POV) POV=$$ACTPROB(RXIEN)
  1.  ..S:'$L(POV) POV=$$PROVNAR
  1.  Q POV
  1.  ;
  1.  ; Prompt for Active Problem List
  1.  ; List is restrict to Problems with Active ICD9 Codes
  1. ACTPROB(RXIEN) ;
  1.  N POV,CNT,PRB,PIEN,DFN,DIR,DUOUT,DIRUT,DTOUT,ICDIEN
  1.  S POV=""
  1.  S DFN=+$$GET1^DIQ(52,RXIEN,2,"I")
  1.  I $D(^AUPNPROB("AC",DFN)) D
  1.  .W !,"Problem list:"
  1.  .S (PIEN,CNT)=0 F  S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN  D
  1.  ..Q:$$GET1^DIQ(80,+$$GET1^DIQ(9000011,PIEN,.01,"I"),100,"I")  ;Quit if Inactive
  1.  ..S CNT=CNT+1 W !?5,CNT,")",?8,$$GET1^DIQ(9000011,PIEN,.01),?15,$$GET1^DIQ(9000011,PIEN,.05) S PRB(CNT)=PIEN
  1.  .I CNT>0 D
  1.  ..S DIR(0)="N^1:"_CNT_":0",DIR("A")="Please select the appropriate Problem List diagnosis for the drug prescribed."
  1.  ..D ^DIR
  1.  ..I '$D(DIRUT) D
  1.  ...S PIEN=PRB(+Y)
  1.  ...S POV=$$ICD(+$P(^AUPNPROB(PIEN,0),U))_U_+$P(^AUPNPROB(PIEN,0),U,5)
  1.  Q POV
  1.  ; Prompt for provider narrative
  1. PROVNAR() ;
  1.  N POV,DIR,DUOUT,DIRUT,DTOUT
  1.  S POV=""
  1.  W !,"Please enter a narrative describing the diagnosis."
  1.  S DIR("A")="Diagnosis Narrative",DIR(0)="9000010.07,.04" D ^DIR
  1.  I '$D(DIRUT) D
  1.  .S POV=".9999"_U_+Y
  1.  E  S POV="999.9"_U_$$PRVNARR^APSPPCC("MEDICATION REFILL")
  1.  Q POV
  1.  ; Prompt for existing purpose of visit
  1. POVS(VIEN) ;
  1.  N POV,POVS,DIR,DUOUT,DIRUT,DTOUT,CNT,PIEN
  1.  S (CNT,PIEN)=0,POV=""
  1.  W !,"Purpose of Visit List:"
  1.  F  S PIEN=$O(^AUPNVPOV("AD",VIEN,PIEN)) Q:'PIEN  D
  1.  .Q:$$POVSEL(PIEN)  ; Screen POVs
  1.  .S CNT=CNT+1 W !?5,CNT,")",?8,$$GET1^DIQ(9000010.07,PIEN,.01),?15,$$GET1^DIQ(9000010.07,PIEN,.04) S POVS(CNT)=PIEN
  1.  I CNT>0 D
  1.  .S DIR(0)="N^1:"_CNT_":0",DIR("A")="Please select the appropriate diagnosis for the drug prescribed."
  1.  .S DIR("B")=1
  1.  .S DIR("?")="Select a number or enter ^ for more choices."
  1.  .D ^DIR
  1.  .I '$D(DIRUT) D
  1.  ..S PIEN=POVS(+Y)
  1.  ..S POV=$$ICD(+$P(^AUPNVPOV(PIEN,0),U))_U_+$P(^AUPNVPOV(PIEN,0),U,4)
  1.  Q POV
  1.  ; Return ICD Code for given IEN
  1. ICD(IEN) ;
  1.  Q $S($$GET1^DIQ(80,+IEN,100,"I"):".9999",1:$$GET1^DIQ(80,+IEN,.01))
  1.  ; Return code selection status
  1.  ; Output: 0 - Code is selectable
  1.  ;         1 - Code is NOT selectable
  1. POVSEL(PIEN) ;EP
  1.  N RES
  1.  S RES=+$$GET1^DIQ(80,+$$GET1^DIQ(9000010.07,PIEN,.01,"I"),100,"I")  ; Check for Inactive flag
  1.  S RES=RES!($$GET1^DIQ(9000010.07,PIEN,.01)="V68.1")   ; Exclude from selection
  1.  Q RES
  1.  ; Set data into XTMP global node
  1. SET(RXIEN,RFIEN,POV) ;
  1.  ;IHS/MSC/PLS - 08/25/2010 - Changed to cache POV in parameter
  1.  D ADD^XPAR("SYS","APSP POV CACHE",+RXIEN_","_+RFIEN,$TR(POV,U,"~"))
  1.  ;L +^XTMP("APSPPCC.VPOV"):2
  1.  ;S ^XTMP("APSPPCC.VPOV",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
  1.  ;S ^XTMP("APSPPCC.VPOV",RXIEN,RFIEN)=POV
  1.  ;L -^XTMP("APSPPCC.VPOV")
  1.  Q
  1.  ; Confirm
  1. CONFIRM(PROMPT,DEFAULT) ; EP
  1.  N DIR
  1.  S DIR("A")=$G(PROMPT)
  1.  S DIR(0)="Y",DIR("B")=$S(+$G(DEFAULT):"Yes",1:"No")
  1.  D ^DIR
  1.  Q Y>0
  1.  ;Return VMED pointer
  1. GETVMED(RXIEN) ;EP
  1.  N RES
  1.  ;First try to return the VMED for the first refill.
  1.  S RES=+$$GET1^DIQ(52.1,"1,"_RXIEN_",",9999999.11,"I")
  1.  Q:RES RES
  1.  ;Otherwise return VMED for the prescription
  1.  Q +$$GET1^DIQ(52,RXIEN,9999999.11,"I")