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

TIUTPBN.m

Go to the documentation of this file. 
  1. TIUTPBN ; SLC/AJB - Trans Pharm Care Note ; July 29, 2003 [3/16/04 1:37pm]
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**170,183,202,287**;Jun 20, 1997;Build 7
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1. EN ;
  1.  X ^%ZOSF("EON") W IOCUON,@IOF
  1.  N FDA,FDAIEN,MSG,POP,TIUDA,TIUFPRIV,TIUIEN,TIUPRNT,TIUTMP
  1.  D PRE
  1.  I $$CHKTITLE(142.5,"TIU TPBN FUTURE APPTS")<0 D  G EXIT
  1.  . W !!,"The Health Summary Object did not install correctly."
  1.  . W !,"Installation cannot continue."
  1.  S TIUFPRIV=1
  1.  S TIUIEN=$$CHKTITLE(8925.1,"TRANSITIONAL PHARMACY BENEFIT NOTE")
  1.  S TIUIEN=$S(TIUIEN>0:TIUIEN,1:"+1")
  1.  I $$CHKTITLE(8930,"CLINICAL COORDINATOR")<0 W !!,"Installation Error:  Class owner cannot be defined.",! G EXIT
  1.  I TIUIEN="+1" F  D  Q:TIUPRNT>0!($D(DUOUT))
  1.  . D GETCLASS
  1.  . I $D(DUOUT) W !!,"Installation Aborted by User." S XPDABORT=1 Q
  1.  . I +TIUPRNT<0 W !!,"Installation Error:  Invalid Selection.",!
  1.  . I  W !,"A DOCUMENT CLASS must be entered or '^' to abort."
  1.  I +$G(TIUPRNT)<0 G EXIT
  1.  I $$MKOBJS<0 Q
  1.  S FDA(8925.1,TIUIEN_",",.01)="TRANSITIONAL PHARMACY BENEFIT NOTE"
  1.  S FDA(8925.1,TIUIEN_",",.02)=""
  1.  S FDA(8925.1,TIUIEN_",",.03)="TRANSITIONAL PHARMACY BENEFIT NOTE"
  1.  S FDA(8925.1,TIUIEN_",",.04)="DOC"
  1.  S FDA(8925.1,TIUIEN_",",.05)=""
  1.  S FDA(8925.1,TIUIEN_",",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
  1.  S FDA(8925.1,TIUIEN_",",.07)=13
  1.  S FDA(8925.1,TIUIEN_",",3.02)=1
  1.  S FDA(8925.1,TIUIEN_",",99)=$H
  1.  D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  I $D(MSG) D  Q
  1.  . W !!,"The following error message was returned:",!!
  1.  . S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  W !!,"Creation of TRANSITIONAL PHARMACY BENEFIT NOTE title successful...",! H 1
  1.  I TIUIEN="+1" D
  1.  . S TIUDA=FDAIEN(1)
  1.  . S FDA(8925.14,"+2,"_TIUPRNT_",",.01)=FDAIEN(1)
  1.  . S FDA(8925.14,"+2,"_TIUPRNT_",",4)="Transitional Pharmacy Benefit Note"
  1.  . D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  . I $D(MSG) D  S XPDABORT=1 Q
  1.  .. W !!,"The following error message was returned:",!!
  1.  .. S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  . W !,"Addition of "_$P(^TIU(8925.1,TIUPRNT,0),U)_" as parent successful...",! H 1
  1.  I $G(TIUDA)="" S TIUDA=TIUIEN
  1.  D GETBOIL
  1.  K FDAIEN
  1.  S FDAIEN(TIUDA)=TIUDA
  1.  S FDA(8925.1,TIUDA_",",3)="TIUTMP"
  1.  D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  I $D(MSG) D  Q
  1.  . W !!,"The following error message was returned:",!!
  1.  . S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  W !,"Boilerplate text and objects added successfully.",!
  1.  W !,"Update finished.",!
  1.  W !,"*** The TRANSITIONAL PHARMACY BENEFIT NOTE title must be"
  1.  W !,"*** activated before use.",!
  1. EXIT D
  1.  .N DIR,X,Y
  1.  .S DIR(0)="E"
  1.  .W ! D ^DIR
  1.  Q
  1. ADD(TXT) ;
  1.  S NEXTLINE=NEXTLINE+1
  1.  S @TARGET@(NEXTLINE,0)=TXT
  1.  Q
  1. ADDSTR(STR1,STR2,MAX) ;
  1.  N CNT,DONE,TMP
  1.  S CNT=0,(DONE,TMP)=""
  1.  I '$D(STR2) D ADD(STR1) Q
  1.  I $L(STR1)<MAX S $P(TMP," ",MAX-$L(STR1))=" ",STR1=STR1_TMP D ADD(STR1_STR2) Q
  1.  E  F  D  Q:DONE=1
  1.  .N TMPSTR S TMPSTR=""
  1.  .I $L(STR1)=MAX,$E(STR1,MAX)=" " S DONE=1 D ADD(STR1_STR2) Q
  1.  .F  D  Q:DONE=1
  1.  ..S CNT=CNT+1
  1.  ..I $L(TMPSTR_$P(STR1," ",CNT)_" ")<60 S TMPSTR=TMPSTR_$P(STR1," ",CNT)_" "
  1.  ..E  S DONE=1,TMP="",$P(TMP," ",MAX-$L(TMPSTR))=" ",TMPSTR=TMPSTR_TMP D ADD(TMPSTR_STR2),ADD($P(STR1," ",CNT,999))
  1.  Q
  1. AOPMEDS(DFN,TARGET) ;
  1.  N DRUG,EMPTY,INDEX,NEXTLINE,NODE,TIUSTAT,TIUSTATS,TMP,NVAMED,NVASTR
  1.  ; *287 initialize TARGET
  1.  K @TARGET
  1.  S EMPTY=1,NEXTLINE=0
  1.  D OCL^PSOORRL(DFN,"","")
  1.  S TIUSTATS="^ACTIVE^REFILL^HOLD^PROVIDER HOLD^ON CALL^ACTIVE (S)^NON-VERIFIED^DRUG INTERACTIONS^INCOMPLETE^PENDING^"
  1.  S INDEX=0
  1.  F  S INDEX=$O(^TMP("PS",$J,INDEX))  Q:INDEX'>0  D
  1.  .S NODE=$G(^TMP("PS",$J,INDEX,0))
  1.  .I '($L($P(NODE,U,2))>0) Q
  1.  .I $P(NODE,U)'["O" Q
  1.  .S TIUSTAT=$P(NODE,U,9) I TIUSTAT="ACTIVE/SUSP" S TIUSTAT="ACTIVE (S)",$P(NODE,U,9)=TIUSTAT
  1.  .I $F(TIUSTATS,"^"_TIUSTAT_"^")=0 Q
  1.  .S EMPTY=0
  1.  .S TMP($P(NODE,U,2),INDEX)=NODE
  1.  .S TMP($P(NODE,U,2),INDEX,"P")=$P($G(^TMP("PS",$J,INDEX,"P",0)),U,2)
  1.  .I ^TMP("PS",$J,INDEX,"SIG",0)>0 D
  1.  ..N TIUSIG S TIUSIG=0
  1.  ..F  S TIUSIG=$O(^TMP("PS",$J,INDEX,"SIG",TIUSIG)) Q:TIUSIG=""  S TMP($P(NODE,U,2),INDEX,"SIG",TIUSIG)=^TMP("PS",$J,INDEX,"SIG",TIUSIG,0)
  1.  ;
  1.  S (DRUG,INDEX)=0
  1.  F  S DRUG=$O(TMP(DRUG)) Q:DRUG=""  F  S INDEX=$O(TMP(DRUG,INDEX)) Q:INDEX=""  D
  1.  . S NODE=TMP(DRUG,INDEX)
  1.  . D ADDSTR("")
  1.  . N SIG S SIG=0
  1.  . S NVASTR=""
  1.  . S NVAMED=$P($P(NODE,U),";")
  1.  . S NVAMED=$E(NVAMED,$L(NVAMED))
  1.  . I NVAMED="N" S NVASTR="Non-VA "
  1.  . F  S SIG=$O(TMP(DRUG,INDEX,"SIG",SIG)) Q:SIG=""  D
  1.  ..I SIG=1 D ADDSTR(NVASTR_DRUG_" "_TMP(DRUG,INDEX,"SIG",SIG),$P(NODE,U,9),60)
  1.  ..I SIG'=1 D ADDSTR(TMP(DRUG,INDEX,"SIG",SIG))
  1.  . D ADDSTR(" # Refills: "_$P(NODE,U,5)," Quantity: "_$P(NODE,U,12),30)
  1.  . D ADDSTR("Issue Date: "_$$FMTE^XLFDT($P(NODE,U,15))," Provider: "_TMP(DRUG,INDEX,"P"),30)
  1.  ;
  1.  I EMPTY D
  1.  .D ADDSTR(""),ADDSTR("No Medications Found"),ADDSTR("")
  1.  K ^TMP("PS",$J)
  1.  Q "~@"_$NA(@TARGET)
  1. GETBOIL ;
  1.  N LINE,LINETXT
  1.  F LINE=1:1 S LINETXT=$P($T(BOILTXT+LINE),";;",2) Q:LINETXT="EOM"  S TIUTMP(LINE)=LINETXT
  1.  Q
  1. BOILTXT ;
  1.  ;;This patient has been identified as a new patient waiting for care from
  1.  ;;the VA and is eligible for the transitional pharmacy program.
  1.  ;;
  1.  ;;Patient Name:  |PATIENT NAME|
  1.  ;;SSN:           |PATIENT SSN|
  1.  ;;Age:           |PATIENT AGE|
  1.  ;;
  1.  ;;Primary Care Provider:  |TIU TPBN PCP|
  1.  ;;
  1.  ;;Allergies/Adverse Reactions:
  1.  ;;|ALLERGIES/ADR|
  1.  ;;
  1.  ;;Rx(s):
  1.  ;;|TIU TPBN ACT OUT MEDS|
  1.  ;;
  1.  ;;Over-the-counter drugs or drugs not issued by VA but currently taking 
  1.  ;;(Please List):
  1.  ;;
  1.  ;;
  1.  ;;
  1.  ;;Non-formulary Rx requested, not filled:
  1.  ;;
  1.  ;;
  1.  ;;
  1.  ;;Formulary Alternatives Recommended:
  1.  ;;
  1.  ;;
  1.  ;;
  1.  ;;Next appointment(s):
  1.  ;;|TIU TPBN FUTURE APPTS|
  1.  ;;
  1.  ;;
  1.  ;;Counseling:
  1.  ;;
  1.  ;;The patient and/or the patient's caregiver was offered counseling on
  1.  ;;drug, dosage, schedule, route of administration, storage, potential 
  1.  ;;side effects, significant drug interactions, and the procedure for 
  1.  ;;obtaining refill prescriptions.
  1.  ;;
  1.  ;;Counseling was [] Provided     [] Refused
  1.  ;;EOM
  1.  Q
  1. CHKTITLE(FILE,NAME) ;
  1.  N DIC,X,Y
  1.  S DIC=FILE,DIC(0)="X"
  1.  S X=NAME
  1.  D ^DIC
  1.  Q +Y
  1. GETCLASS ;
  1.  N DIC,X,Y
  1.  S DIC("A")="Select the DOCUMENT CLASS where the new title will be installed:  "
  1.  S DIC(0)="AEQ",DIC="^TIU(8925.1,",DIC("S")="I $P(^(0),U,4)=""DC"""
  1.  W ! D ^DIC
  1.  S TIUPRNT=+Y
  1.  Q
  1. MKOBJS() ;
  1.  N TIUHSO
  1.  S TIUHSO=$$CHKTITLE(142.5,"TIU TPBN FUTURE APPTS")
  1.  I $$MKOBJ("TIU TPBN ACT OUT MEDS","S X=$$AOPMEDS^TIUTPBN(DFN,""^TMP(""""TIUMED"""",$J)"")")<0 D  Q -1
  1.  . W !!,"Installation Error:  TIU Object creation failed.",!
  1.  I $$MKOBJ("TIU TPBN FUTURE APPTS","S X=$$TIU^GMTSOBJ(DFN,"_TIUHSO_")")<0 D  Q -1
  1.  . W !!,"Installation Error:  TIU Object creation failed.",!
  1.  I $$MKOBJ("TIU TPBN PCP","S X=$P($$OUTPTPR^SDUTL3(DFN,DT),U,2)")<0 D  Q -1
  1.  . W !!,"Installation Error:  TIU Object creation failed.",!
  1.  Q 1
  1. MKOBJ(NAME,METHOD) ;
  1.  N FDA,FDAIEN,MSG
  1.  S FDA(8925.1,"+1,",.01)=NAME
  1.  S FDA(8925.1,"+1,",.03)=NAME
  1.  S FDA(8925.1,"+1,",.04)="O"
  1.  S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
  1.  S FDA(8925.1,"+1,",.07)=11
  1.  S FDA(8925.1,"+1,",9)=METHOD
  1.  S FDA(8925.1,"+1,",99)=$H
  1.  D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  I $D(MSG) D  Q -1
  1.  . W !!,"TIU Object "_NAME_" creation failed.  The following error message was returned:",!!
  1.  . S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  W !!,"Creation of TIU Object "_NAME_" successful..." H 1
  1.  Q 1
  1. PRE ;
  1.  N DA,DIK,NAME,X,Y
  1.  F NAME="TIU TPBN ACT OUT MEDS","TIU TPBN FUTURE APPTS","TIU TPBN PCP" D
  1.  .S DA=0,DA=$O(^TIU(8925.1,"B",NAME,DA))
  1.  .S DIK="^TIU(8925.1,"
  1.  .I DA>0 D ^DIK
  1.  S NAME="INS^GMTSOBJ"
  1.  D @NAME
  1.  Q