PSANDCUT ;BIRM/MFR - NDC Utility ;07/01/08
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69,72**;10/24/97;Build 2
;References to ^PSSNDCUT supported by IA #4707
;
NDCEDT(DRG,NDC) ; Allows editing of the Rx NDC code
; Input: (o) DRG - Drug IEN (#50)
; (o) NDC - Default NDC Number/Return parameter
;Output: (r) .NDC - Selected NDC Number ("" means no NDC selected) (Note: REQUIRED for Output value)
;
N SNDC,SYN,Z,IDX,I,PID,DFN,DRGNAM,PRPT,DIR,X,Y
K ^TMP($J,"PSANDCDP"),^TMP($J,"PSANDCFM")
;
; - Setting the NDC currently on the PRESCRIPTION (passed in)
S IDX=0
I $G(NDC)'="" S IDX=1,^TMP($J,"PSANDCFM",IDX)=NDC,^TMP($J,"PSANDCDP",NDC)=IDX
;
; - Retrieving NDC from the DRUG/NDF files
S NDC=$$GETNDC^PSSNDCUT(DRG)
I NDC'="",'$D(^TMP($J,"PSANDCDP",NDC)) D
. S IDX=IDX+1,^TMP($J,"PSANDCFM",IDX)=NDC,^TMP($J,"PSANDCDP",NDC)=IDX
;
; - Retrieving NDCs from SYNONYMS
S SYN=0
F S SYN=$O(^PSDRUG(DRG,1,SYN)) Q:SYN="" D
. S Z=$G(^PSDRUG(DRG,1,SYN,0)),SNDC=$$NDCFMT^PSSNDCUT($P(Z,"^",2)) I SNDC="" Q
. I $D(^TMP($J,"PSANDCDP",SNDC)) Q
. S IDX=IDX+1,^TMP($J,"PSANDCFM",IDX)=SNDC
. S ^TMP($J,"PSANDCDP",SNDC)=IDX
;
ASK ; Ask for NDC
N DIR,Y,DIRUT,DIROUT
K DIR S DIR(0)="FOA^1:15",DIR("A")="NDC: ",DIR("B")=$G(^TMP($J,"PSANDCFM",1)) I DIR("B")="" K DIR("B")
S DIR("?")="^D NDCHLP^PSANDCUT"
DEL ; Ask again after deleted
D ^DIR I X="@" K DIR("B") S NDC="" W " Deleted!" G DEL
I $D(DIRUT)!$D(DIROUT) S NDC=$S($D(DIRUT):X,1:"^") G END
I Y?.N D
. S NDC=$S($D(^TMP($J,"PSANDCDP",Y)):Y,1:"") I NDC'="" Q
. S NDC=$S($D(^TMP($J,"PSANDCFM",+Y)):^TMP($J,"PSANDCFM",+Y),1:"") I NDC'="" Q
. S NDC=Y
E S NDC=$TR(Y," ")
W " ",NDC
;
END K ^TMP($J,"PSANDCDP"),^TMP($J,"PSANDCFM")
Q
;
NDCHLP ; Help Text for the NDC Code Selection
N I
W !?10,"Select one of the following NDC(s) below:",!
I $D(^TMP($J,"PSANDCFM")) D
. S I=0 F S I=$O(^TMP($J,"PSANDCFM",I)) Q:'I D
. . W !?15,$J(I,2)," - ",^TMP($J,"PSANDCFM",I)
E W !?12,"<No NDC(s) available for this drug>"
W !!?10,"Or enter it manually in case the correct"
W !?10,"NDC is not on the list above."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSANDCUT 2151 printed Apr 09, 2024@20:54:04 Page 2
PSANDCUT ;BIRM/MFR - NDC Utility ;07/01/08
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69,72**;10/24/97;Build 2
+2 ;References to ^PSSNDCUT supported by IA #4707
+3 ;
NDCEDT(DRG,NDC) ; Allows editing of the Rx NDC code
+1 ; Input: (o) DRG - Drug IEN (#50)
+2 ; (o) NDC - Default NDC Number/Return parameter
+3 ;Output: (r) .NDC - Selected NDC Number ("" means no NDC selected) (Note: REQUIRED for Output value)
+4 ;
+5 NEW SNDC,SYN,Z,IDX,I,PID,DFN,DRGNAM,PRPT,DIR,X,Y
+6 KILL ^TMP($JOB,"PSANDCDP"),^TMP($JOB,"PSANDCFM")
+7 ;
+8 ; - Setting the NDC currently on the PRESCRIPTION (passed in)
+9 SET IDX=0
+10 IF $GET(NDC)'=""
SET IDX=1
SET ^TMP($JOB,"PSANDCFM",IDX)=NDC
SET ^TMP($JOB,"PSANDCDP",NDC)=IDX
+11 ;
+12 ; - Retrieving NDC from the DRUG/NDF files
+13 SET NDC=$$GETNDC^PSSNDCUT(DRG)
+14 IF NDC'=""
IF '$DATA(^TMP($JOB,"PSANDCDP",NDC))
Begin DoDot:1
+15 SET IDX=IDX+1
SET ^TMP($JOB,"PSANDCFM",IDX)=NDC
SET ^TMP($JOB,"PSANDCDP",NDC)=IDX
End DoDot:1
+16 ;
+17 ; - Retrieving NDCs from SYNONYMS
+18 SET SYN=0
+19 FOR
SET SYN=$ORDER(^PSDRUG(DRG,1,SYN))
if SYN=""
QUIT
Begin DoDot:1
+20 SET Z=$GET(^PSDRUG(DRG,1,SYN,0))
SET SNDC=$$NDCFMT^PSSNDCUT($PIECE(Z,"^",2))
IF SNDC=""
QUIT
+21 IF $DATA(^TMP($JOB,"PSANDCDP",SNDC))
QUIT
+22 SET IDX=IDX+1
SET ^TMP($JOB,"PSANDCFM",IDX)=SNDC
+23 SET ^TMP($JOB,"PSANDCDP",SNDC)=IDX
End DoDot:1
+24 ;
ASK ; Ask for NDC
+1 NEW DIR,Y,DIRUT,DIROUT
+2 KILL DIR
SET DIR(0)="FOA^1:15"
SET DIR("A")="NDC: "
SET DIR("B")=$GET(^TMP($JOB,"PSANDCFM",1))
IF DIR("B")=""
KILL DIR("B")
+3 SET DIR("?")="^D NDCHLP^PSANDCUT"
DEL ; Ask again after deleted
+1 DO ^DIR
IF X="@"
KILL DIR("B")
SET NDC=""
WRITE " Deleted!"
GOTO DEL
+2 IF $DATA(DIRUT)!$DATA(DIROUT)
SET NDC=$SELECT($DATA(DIRUT):X,1:"^")
GOTO END
+3 IF Y?.N
Begin DoDot:1
+4 SET NDC=$SELECT($DATA(^TMP($JOB,"PSANDCDP",Y)):Y,1:"")
IF NDC'=""
QUIT
+5 SET NDC=$SELECT($DATA(^TMP($JOB,"PSANDCFM",+Y)):^TMP($JOB,"PSANDCFM",+Y),1:"")
IF NDC'=""
QUIT
+6 SET NDC=Y
End DoDot:1
+7 IF '$TEST
SET NDC=$TRANSLATE(Y," ")
+8 WRITE " ",NDC
+9 ;
END KILL ^TMP($JOB,"PSANDCDP"),^TMP($JOB,"PSANDCFM")
+1 QUIT
+2 ;
NDCHLP ; Help Text for the NDC Code Selection
+1 NEW I
+2 WRITE !?10,"Select one of the following NDC(s) below:",!
+3 IF $DATA(^TMP($JOB,"PSANDCFM"))
Begin DoDot:1
+4 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PSANDCFM",I))
if 'I
QUIT
Begin DoDot:2
+5 WRITE !?15,$JUSTIFY(I,2)," - ",^TMP($JOB,"PSANDCFM",I)
End DoDot:2
End DoDot:1
+6 IF '$TEST
WRITE !?12,"<No NDC(s) available for this drug>"
+7 WRITE !!?10,"Or enter it manually in case the correct"
+8 WRITE !?10,"NDC is not on the list above."
+9 QUIT
