PSSTXT ;BIR/WRT-Edit DRUG TEXT file routine ; 11/15/01 8:11
;;1.0;PHARMACY DATA MANAGEMENT;**29,55,194**;9/30/97;Build 9
BEGIN S PSSNFI=1,PSSFG=0 W !,"This option enables you to edit entries in the DRUG TEXT file.",!! F PSSQQ=1:1 K DA D ASK Q:PSSFG
DONE K DA,PSSFG,PSSQQ,PSSNFI,NAME,PSSENT,PSSBEG,PSSEND,PSSSRT,PSSXX
K %,D,D0,DI,DIE,DLAYGO,DQ,DR,X,Y
Q
;
ASK W ! S DIC="^PS(51.7,",DIC(0)="QEALMN",DLAYGO=51.7 D ^DIC K DIC I Y<0 S PSSFG=1 Q
S PSSENT=+Y D WRIT,REVW W ! S DA=PSSENT S DIE="^PS(51.7,"
D NAME I PSSFG Q
D TEXT I PSSFG Q
W !
S DR="1;2" D ^DIE,CHECKI
Q
CHECK I '$O(^PS(51.7,DA,2,0)),'$D(^PS(50.7,"DTXT",DA)),'$D(^PSDRUG("DTXT",DA)) S DIK="^PS(51.7," D ^DIK K DIK
Q
;
WRIT W !!,"There may be entries in your DRUG file and PHARMACY ORDERABLE ITEM file linked",!,"to this Drug Text Name. Editing information related to this Drug Text entry",!
W "will affect the display of information related to these.",!
Q
;
REVW K DIR S DIR("A")="Do you want to review the list of drugs and orderable items linked to this Drug Text entry? ",DIR(0)="Y",DIR("B")="YES"
S DIR("?",1)="Answering 'Yes' will list all entries in the Drug file or Orderable Item file",DIR("?",2)="that are linked to this drug text entry. The list could be long, so a "
S DIR("?")="device can be entered to print a hard copy, if desired."
D ^DIR K DIR
I Y=1 D D RPT^PSSDTR
. S PSSSRT="S"
. S (PSSXX,PSSBEG,PSSEND)=$P($G(^PS(51.7,PSSENT,0)),"^",1)
Q
;
OUTMSG W !!,"IMPORTANT!! After editing the Drug Text Name OR Text, review the drugs and",!?12,"orderable items linked to this entry for accuracy."
Q
;
CHECKI I $P($G(^PS(51.7,DA,0)),"^",2) D MSG
Q
;
MSG W !!,"Because this entry was inactivated, drugs and orderable items that are linked",!,"to this entry will no longer display the text associated with this entry."
W !,"You should review all drugs and orderable items associated with this Drug Text",!,"entry and update appropriately.",!
Q
;
NAME ;
N PSSNAME
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to edit the Drug Text Name",DIR("B")="NO" D ^DIR K DIR
I X["^" S PSSFG=1 Q
D OUTMSG
I '$G(Y) Q
S PSSNAME=$P($G(^PS(51.7,DA,0)),"^",1)
W ! K DIR S DIR(0)="FO^1:75",DIR("A")="Drug Text Name: ",DIR("B")=PSSNAME D ^DIR K DIR
I $G(X)["^" S PSSFG=1 Q
I X'="",X'=PSSNAME D
. I X["@" W " **DELETIONS ARE NOT ALLOWED!" Q
. S ^PS(51.7,"B",$E(X,1,30),DA)=""
. K ^PS(51.7,"B",$E(PSSNAME,1,30),DA)
. S $P(^PS(51.7,DA,0),"^",1)=X
Q
;
TEXT ;
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to edit the text for this entry",DIR("B")="YES" D ^DIR K DIR
I $G(X)["^" S PSSFG=1 Q
I '+($G(Y)) Q
W !!,"WARNING: The absence of text lines will cause this Drug Text entry"
W !," to be completely deleted."
W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
W ! S DR="3" D ^DIE,CHECK
;set flag if all text was deleted which deleted this entry
I '$O(^PS(51.7,DA,2,0)) D
. S PSSFG=1
. W !!," **** **** **** **** **** **** **** **** **** **** ****"
. W !!," The absence of text lines caused this Drug Text entry"
. W !," to be completely deleted."
. W !!," Therefore, Synonym and Inactivation Date"
. W !," will not be asked."
. W !!," **** **** **** **** **** **** **** **** **** **** ****",!!
. S DIR(0)="E",DIR("A")=" Press Return to continue" D ^DIR K DIR
. W !
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSTXT 3392 printed Nov 22, 2024@17:44:31 Page 2
PSSTXT ;BIR/WRT-Edit DRUG TEXT file routine ; 11/15/01 8:11
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**29,55,194**;9/30/97;Build 9
BEGIN SET PSSNFI=1
SET PSSFG=0
WRITE !,"This option enables you to edit entries in the DRUG TEXT file.",!!
FOR PSSQQ=1:1
KILL DA
DO ASK
if PSSFG
QUIT
DONE KILL DA,PSSFG,PSSQQ,PSSNFI,NAME,PSSENT,PSSBEG,PSSEND,PSSSRT,PSSXX
+1 KILL %,D,D0,DI,DIE,DLAYGO,DQ,DR,X,Y
+2 QUIT
+3 ;
ASK WRITE !
SET DIC="^PS(51.7,"
SET DIC(0)="QEALMN"
SET DLAYGO=51.7
DO ^DIC
KILL DIC
IF Y<0
SET PSSFG=1
QUIT
+1 SET PSSENT=+Y
DO WRIT
DO REVW
WRITE !
SET DA=PSSENT
SET DIE="^PS(51.7,"
+2 DO NAME
IF PSSFG
QUIT
+3 DO TEXT
IF PSSFG
QUIT
+4 WRITE !
+5 SET DR="1;2"
DO ^DIE
DO CHECKI
+6 QUIT
CHECK IF '$ORDER(^PS(51.7,DA,2,0))
IF '$DATA(^PS(50.7,"DTXT",DA))
IF '$DATA(^PSDRUG("DTXT",DA))
SET DIK="^PS(51.7,"
DO ^DIK
KILL DIK
+1 QUIT
+2 ;
WRIT WRITE !!,"There may be entries in your DRUG file and PHARMACY ORDERABLE ITEM file linked",!,"to this Drug Text Name. Editing information related to this Drug Text entry",!
+1 WRITE "will affect the display of information related to these.",!
+2 QUIT
+3 ;
REVW KILL DIR
SET DIR("A")="Do you want to review the list of drugs and orderable items linked to this Drug Text entry? "
SET DIR(0)="Y"
SET DIR("B")="YES"
+1 SET DIR("?",1)="Answering 'Yes' will list all entries in the Drug file or Orderable Item file"
SET DIR("?",2)="that are linked to this drug text entry. The list could be long, so a "
+2 SET DIR("?")="device can be entered to print a hard copy, if desired."
+3 DO ^DIR
KILL DIR
+4 IF Y=1
Begin DoDot:1
+5 SET PSSSRT="S"
+6 SET (PSSXX,PSSBEG,PSSEND)=$PIECE($GET(^PS(51.7,PSSENT,0)),"^",1)
End DoDot:1
DO RPT^PSSDTR
+7 QUIT
+8 ;
OUTMSG WRITE !!,"IMPORTANT!! After editing the Drug Text Name OR Text, review the drugs and",!?12,"orderable items linked to this entry for accuracy."
+1 QUIT
+2 ;
CHECKI IF $PIECE($GET(^PS(51.7,DA,0)),"^",2)
DO MSG
+1 QUIT
+2 ;
MSG WRITE !!,"Because this entry was inactivated, drugs and orderable items that are linked",!,"to this entry will no longer display the text associated with this entry."
+1 WRITE !,"You should review all drugs and orderable items associated with this Drug Text",!,"entry and update appropriately.",!
+2 QUIT
+3 ;
NAME ;
+1 NEW PSSNAME
+2 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to edit the Drug Text Name"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+3 IF X["^"
SET PSSFG=1
QUIT
+4 DO OUTMSG
+5 IF '$GET(Y)
QUIT
+6 SET PSSNAME=$PIECE($GET(^PS(51.7,DA,0)),"^",1)
+7 WRITE !
KILL DIR
SET DIR(0)="FO^1:75"
SET DIR("A")="Drug Text Name: "
SET DIR("B")=PSSNAME
DO ^DIR
KILL DIR
+8 IF $GET(X)["^"
SET PSSFG=1
QUIT
+9 IF X'=""
IF X'=PSSNAME
Begin DoDot:1
+10 IF X["@"
WRITE " **DELETIONS ARE NOT ALLOWED!"
QUIT
+11 SET ^PS(51.7,"B",$EXTRACT(X,1,30),DA)=""
+12 KILL ^PS(51.7,"B",$EXTRACT(PSSNAME,1,30),DA)
+13 SET $PIECE(^PS(51.7,DA,0),"^",1)=X
End DoDot:1
+14 QUIT
+15 ;
TEXT ;
+1 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to edit the text for this entry"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+2 IF $GET(X)["^"
SET PSSFG=1
QUIT
+3 IF '+($GET(Y))
QUIT
+4 WRITE !!,"WARNING: The absence of text lines will cause this Drug Text entry"
+5 WRITE !," to be completely deleted."
+6 WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+7 WRITE !
SET DR="3"
DO ^DIE
DO CHECK
+8 ;set flag if all text was deleted which deleted this entry
+9 IF '$ORDER(^PS(51.7,DA,2,0))
Begin DoDot:1
+10 SET PSSFG=1
+11 WRITE !!," **** **** **** **** **** **** **** **** **** **** ****"
+12 WRITE !!," The absence of text lines caused this Drug Text entry"
+13 WRITE !," to be completely deleted."
+14 WRITE !!," Therefore, Synonym and Inactivation Date"
+15 WRITE !," will not be asked."
+16 WRITE !!," **** **** **** **** **** **** **** **** **** **** ****",!!
+17 SET DIR(0)="E"
SET DIR("A")=" Press Return to continue"
DO ^DIR
KILL DIR
+18 WRITE !
End DoDot:1
+19 QUIT
+20 ;
