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