- 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 Jan 18, 2025@03:35:12 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 ;