PSSNDCUT2 ;AITC/PD - NDC Utilities 2;6/1/21
;;1.0;PHARMACY DATA MANAGEMENT;**252**;9/30/97;Build 17
;
Q
;
; Allow user to edit LAST LOCAL NDC and LAST CMOP NDC
; of the NDC BY OUTPATIENT SITE subfile (#50.032)
; An audit trail of any edits will be captured
;
; Input: PSS50 - Drug File (#50) IEN
;
OPS(PSS50) ; Outpatient Site
OPS1 ;
N DIR,DIRUT,NDC,NDC1PRE,NDC2PRE,NDCAR,NDCSITE,QUIT,X,Y
S DIR(0)="PO^PSDRUG("_PSS50_",""NDCOP"",:QE"
S DIR("A")="Select OUTPATIENT SITE"
D ^DIR
I $D(DIRUT)!(Y=-1) Q
S NDCSITE=+Y
; Capture value of Local and CMOP NDCs before any edits
S NDC1PRE=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,1)
S NDC2PRE=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,2)
;
; Build array of valid NDCs
D NDCARRAY
I '$D(NDCAR) D Q
. W !!,"No valid NDCs found for "_$$GET1^DIQ(50,PSS50,.01)
;
; Last LOCAL NDC
D ASKNDC(1)
I $G(QUIT) Q
I (NDC'=""),(NDC1PRE'=NDC) D FILENDC(1)
;
; Last CMOP NDC
D ASKNDC(2)
I $G(QUIT) D AUDIT Q
I (NDC'=""),(NDC2PRE'=NDC) D FILENDC(2)
;
D AUDIT
G OPS1
Q
;
; FLG: 1 = Last LOCAL NDC
; 2 = Last CMOP NDC
ASKNDC(FLG) ; Prompt for NDC
ASKNDC1 ;
;
N DEFLT,DELETE,DIR,DIRUT,PRMPT,X,Y
S NDC=""
;
I FLG=1 D
. S PRMPT="LOCAL"
. S DEFLT=NDC1PRE
I FLG=2 D
. S PRMPT="CMOP"
. S DEFLT=NDC2PRE
;
S DIR(0)="FAO^1:15"
S DIR("A")=" LAST "_PRMPT_" NDC: "
S DIR("B")=$G(DEFLT)
S DIR("?")="^D NDCHLP^PSSNDCUT2"
D ^DIR
;
I $D(DIRUT),X'="@",Y'="" S QUIT=1 Q
I $D(DIRUT),X'="@",Y="" S QUIT=0 Q
;
I X="@" S DELETE=$$DELETE()
I X="@",DELETE S NDC="@" Q
I X="@",'DELETE G ASKNDC1
;
I Y'?.N S NDC=Y I '$D(NDCAR(1,NDC)) D NDCHLP2 G ASKNDC1
I Y?.N D I NDC="" D NDCHLP2 G ASKNDC1
. I $L(Y)=11 S NDC=$$NDCFMT^PSSNDCUT(Y) D Q
. . I NDC'="",'$D(NDCAR(1,NDC)) S NDC=""
. S NDC=$G(NDCAR(2,+Y))
W " ",NDC
Q
;
FILENDC(FLG) ; Save NDC
;
N ARRAY
S ARRAY(50.032,NDCSITE_","_PSS50_",",FLG)=NDC
D FILE^DIE("","ARRAY")
Q
;
; Build array of valid NDCs for the specific drug selected.
; Valid values include:
; Field 31 of DRUG file (#50) - NDC
; Field 2 of SYNONYM subfile (#50.1) - NDC CODE
; Fields 1 and 2 of NDC BY OUTPATIENT SITE subfile (#50.032)
; 1 = LAST LOCAL NDC
; 2 = LAST CMOP NDC
NDCARRAY ;
K NDCAR
N CNT,NDC,NDCI
; Field 31 - NDC
S NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50,PSS50,31))
I NDC'="" S NDCAR(1,NDC)=""
; Loop through SYNONYM multiple
S NDCI=0
F S NDCI=$O(^PSDRUG(PSS50,1,NDCI)) Q:'NDCI D
. ; Field 2 - NDC CODE
. S NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50.1,NDCI_","_PSS50_",",2))
. I NDC'="" S NDCAR(1,NDC)=""
; Loop through NDC BY OUTPATIENT SITE multiple
S NDCI=0
F S NDCI=$O(^PSDRUG(PSS50,"NDCOP",NDCI)) Q:'NDCI D
. ; Field 1 - LAST LOCAL NDC
. S NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50.032,NDCI_","_PSS50_",",1))
. I NDC'="" S NDCAR(1,NDC)=""
. ; Field 2 - LAST CMOP NDC
. S NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50.032,NDCI_","_PSS50_",",2))
. I NDC'="" S NDCAR(1,NDC)=""
;
S CNT=0
S NDC=""
F S NDC=$O(NDCAR(1,NDC)) Q:NDC="" D
. S CNT=CNT+1
. S NDCAR(1,NDC)=CNT
. S NDCAR(2,CNT)=NDC
;
Q
;
; Capture Date/Time and User of the edit
; Audit record will show before/after of each field
; If neither LAST LOCAL NDC or LAST CMOP NDC did not change, an
; audit record will not be created
AUDIT ; Audit Trail
N FILE,IEN,NDC1POST,NDC2POST,NDCAUD,NDCIEN,PSSNO2,PSSNOW
K NDCAR
;
S NDC1POST=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,1)
S NDC2POST=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,2)
;
; No changes to LOCAL or CMOP NDC - Audit subfile entry not necessary
I (NDC1PRE=NDC1POST)&(NDC2PRE=NDC2POST) Q
;
; Create NDC BY OUTPATIENT SITE AUDIT subfile entry
S PSSNOW=$$NOW^XLFDT
S FILE=50.0321
S NDCAR(1,FILE,"+1,"_NDCSITE_","_PSS50_",",.01)=PSSNOW
D UPDATE^DIE("","NDCAR(1)")
K NDCAR
;
I NDC1PRE="" S NDC1PRE="<blank>"
I NDC1POST="" S NDC1POST="<blank>"
I NDC2PRE="" S NDC2PRE="<blank>"
I NDC2POST="" S NDC2POST="<blank>"
;
; Populate fields in the new subfile entry
S NDCAUD=$O(^PSDRUG(PSS50,"NDCOP",NDCSITE,1,"B",PSSNOW,""))
S NDCIEN=NDCAUD_","_NDCSITE_","_PSS50_","
S NDCAR(FILE,NDCIEN,1)=DUZ
; Only populate fields for which the NDC value changed
I NDC1PRE'=NDC1POST D
. S NDCAR(FILE,NDCIEN,2)=NDC1PRE
. S NDCAR(FILE,NDCIEN,3)=NDC1POST
I NDC2PRE'=NDC2POST D
. S NDCAR(FILE,NDCIEN,4)=NDC2PRE
. S NDCAR(FILE,NDCIEN,5)=NDC2POST
D FILE^DIE(,"NDCAR")
;
K NDCAR
;
Q
;
NDCHLP2 ; Invalid NDC entry
;
W !!,"NDC is not valid."
;
NDCHLP ; Display list of valid NDCs
;
S PSSI=""
W !,"Select from one of the following valid NDC(s) or enter ^ to exit:",!
F S PSSI=$O(NDCAR(2,PSSI)) Q:PSSI="" D
. W !?3,PSSI_" - "_NDCAR(2,PSSI)
Q
;
DELETE() ; Confirm Deletion of NDC
;
N DIR,DIRUT,X,Y
S DIR(0)="Y"
S DIR("A")=" SURE YOU WANT TO DELETE"
S DIR("B")="YES"
D ^DIR
I $D(DIRUT) Q 0
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSNDCUT2 4927 printed Apr 09, 2024@21:33:38 Page 2
PSSNDCUT2 ;AITC/PD - NDC Utilities 2;6/1/21
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**252**;9/30/97;Build 17
+2 ;
+3 QUIT
+4 ;
+5 ; Allow user to edit LAST LOCAL NDC and LAST CMOP NDC
+6 ; of the NDC BY OUTPATIENT SITE subfile (#50.032)
+7 ; An audit trail of any edits will be captured
+8 ;
+9 ; Input: PSS50 - Drug File (#50) IEN
+10 ;
OPS(PSS50) ; Outpatient Site
OPS1 ;
+1 NEW DIR,DIRUT,NDC,NDC1PRE,NDC2PRE,NDCAR,NDCSITE,QUIT,X,Y
+2 SET DIR(0)="PO^PSDRUG("_PSS50_",""NDCOP"",:QE"
+3 SET DIR("A")="Select OUTPATIENT SITE"
+4 DO ^DIR
+5 IF $DATA(DIRUT)!(Y=-1)
QUIT
+6 SET NDCSITE=+Y
+7 ; Capture value of Local and CMOP NDCs before any edits
+8 SET NDC1PRE=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,1)
+9 SET NDC2PRE=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,2)
+10 ;
+11 ; Build array of valid NDCs
+12 DO NDCARRAY
+13 IF '$DATA(NDCAR)
Begin DoDot:1
+14 WRITE !!,"No valid NDCs found for "_$$GET1^DIQ(50,PSS50,.01)
End DoDot:1
QUIT
+15 ;
+16 ; Last LOCAL NDC
+17 DO ASKNDC(1)
+18 IF $GET(QUIT)
QUIT
+19 IF (NDC'="")
IF (NDC1PRE'=NDC)
DO FILENDC(1)
+20 ;
+21 ; Last CMOP NDC
+22 DO ASKNDC(2)
+23 IF $GET(QUIT)
DO AUDIT
QUIT
+24 IF (NDC'="")
IF (NDC2PRE'=NDC)
DO FILENDC(2)
+25 ;
+26 DO AUDIT
+27 GOTO OPS1
+28 QUIT
+29 ;
+30 ; FLG: 1 = Last LOCAL NDC
+31 ; 2 = Last CMOP NDC
ASKNDC(FLG) ; Prompt for NDC
ASKNDC1 ;
+1 ;
+2 NEW DEFLT,DELETE,DIR,DIRUT,PRMPT,X,Y
+3 SET NDC=""
+4 ;
+5 IF FLG=1
Begin DoDot:1
+6 SET PRMPT="LOCAL"
+7 SET DEFLT=NDC1PRE
End DoDot:1
+8 IF FLG=2
Begin DoDot:1
+9 SET PRMPT="CMOP"
+10 SET DEFLT=NDC2PRE
End DoDot:1
+11 ;
+12 SET DIR(0)="FAO^1:15"
+13 SET DIR("A")=" LAST "_PRMPT_" NDC: "
+14 SET DIR("B")=$GET(DEFLT)
+15 SET DIR("?")="^D NDCHLP^PSSNDCUT2"
+16 DO ^DIR
+17 ;
+18 IF $DATA(DIRUT)
IF X'="@"
IF Y'=""
SET QUIT=1
QUIT
+19 IF $DATA(DIRUT)
IF X'="@"
IF Y=""
SET QUIT=0
QUIT
+20 ;
+21 IF X="@"
SET DELETE=$$DELETE()
+22 IF X="@"
IF DELETE
SET NDC="@"
QUIT
+23 IF X="@"
IF 'DELETE
GOTO ASKNDC1
+24 ;
+25 IF Y'?.N
SET NDC=Y
IF '$DATA(NDCAR(1,NDC))
DO NDCHLP2
GOTO ASKNDC1
+26 IF Y?.N
Begin DoDot:1
+27 IF $LENGTH(Y)=11
SET NDC=$$NDCFMT^PSSNDCUT(Y)
Begin DoDot:2
+28 IF NDC'=""
IF '$DATA(NDCAR(1,NDC))
SET NDC=""
End DoDot:2
QUIT
+29 SET NDC=$GET(NDCAR(2,+Y))
End DoDot:1
IF NDC=""
DO NDCHLP2
GOTO ASKNDC1
+30 WRITE " ",NDC
+31 QUIT
+32 ;
FILENDC(FLG) ; Save NDC
+1 ;
+2 NEW ARRAY
+3 SET ARRAY(50.032,NDCSITE_","_PSS50_",",FLG)=NDC
+4 DO FILE^DIE("","ARRAY")
+5 QUIT
+6 ;
+7 ; Build array of valid NDCs for the specific drug selected.
+8 ; Valid values include:
+9 ; Field 31 of DRUG file (#50) - NDC
+10 ; Field 2 of SYNONYM subfile (#50.1) - NDC CODE
+11 ; Fields 1 and 2 of NDC BY OUTPATIENT SITE subfile (#50.032)
+12 ; 1 = LAST LOCAL NDC
+13 ; 2 = LAST CMOP NDC
NDCARRAY ;
+1 KILL NDCAR
+2 NEW CNT,NDC,NDCI
+3 ; Field 31 - NDC
+4 SET NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50,PSS50,31))
+5 IF NDC'=""
SET NDCAR(1,NDC)=""
+6 ; Loop through SYNONYM multiple
+7 SET NDCI=0
+8 FOR
SET NDCI=$ORDER(^PSDRUG(PSS50,1,NDCI))
if 'NDCI
QUIT
Begin DoDot:1
+9 ; Field 2 - NDC CODE
+10 SET NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50.1,NDCI_","_PSS50_",",2))
+11 IF NDC'=""
SET NDCAR(1,NDC)=""
End DoDot:1
+12 ; Loop through NDC BY OUTPATIENT SITE multiple
+13 SET NDCI=0
+14 FOR
SET NDCI=$ORDER(^PSDRUG(PSS50,"NDCOP",NDCI))
if 'NDCI
QUIT
Begin DoDot:1
+15 ; Field 1 - LAST LOCAL NDC
+16 SET NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50.032,NDCI_","_PSS50_",",1))
+17 IF NDC'=""
SET NDCAR(1,NDC)=""
+18 ; Field 2 - LAST CMOP NDC
+19 SET NDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50.032,NDCI_","_PSS50_",",2))
+20 IF NDC'=""
SET NDCAR(1,NDC)=""
End DoDot:1
+21 ;
+22 SET CNT=0
+23 SET NDC=""
+24 FOR
SET NDC=$ORDER(NDCAR(1,NDC))
if NDC=""
QUIT
Begin DoDot:1
+25 SET CNT=CNT+1
+26 SET NDCAR(1,NDC)=CNT
+27 SET NDCAR(2,CNT)=NDC
End DoDot:1
+28 ;
+29 QUIT
+30 ;
+31 ; Capture Date/Time and User of the edit
+32 ; Audit record will show before/after of each field
+33 ; If neither LAST LOCAL NDC or LAST CMOP NDC did not change, an
+34 ; audit record will not be created
AUDIT ; Audit Trail
+1 NEW FILE,IEN,NDC1POST,NDC2POST,NDCAUD,NDCIEN,PSSNO2,PSSNOW
+2 KILL NDCAR
+3 ;
+4 SET NDC1POST=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,1)
+5 SET NDC2POST=$$GET1^DIQ(50.032,NDCSITE_","_PSS50,2)
+6 ;
+7 ; No changes to LOCAL or CMOP NDC - Audit subfile entry not necessary
+8 IF (NDC1PRE=NDC1POST)&(NDC2PRE=NDC2POST)
QUIT
+9 ;
+10 ; Create NDC BY OUTPATIENT SITE AUDIT subfile entry
+11 SET PSSNOW=$$NOW^XLFDT
+12 SET FILE=50.0321
+13 SET NDCAR(1,FILE,"+1,"_NDCSITE_","_PSS50_",",.01)=PSSNOW
+14 DO UPDATE^DIE("","NDCAR(1)")
+15 KILL NDCAR
+16 ;
+17 IF NDC1PRE=""
SET NDC1PRE="<blank>"
+18 IF NDC1POST=""
SET NDC1POST="<blank>"
+19 IF NDC2PRE=""
SET NDC2PRE="<blank>"
+20 IF NDC2POST=""
SET NDC2POST="<blank>"
+21 ;
+22 ; Populate fields in the new subfile entry
+23 SET NDCAUD=$ORDER(^PSDRUG(PSS50,"NDCOP",NDCSITE,1,"B",PSSNOW,""))
+24 SET NDCIEN=NDCAUD_","_NDCSITE_","_PSS50_","
+25 SET NDCAR(FILE,NDCIEN,1)=DUZ
+26 ; Only populate fields for which the NDC value changed
+27 IF NDC1PRE'=NDC1POST
Begin DoDot:1
+28 SET NDCAR(FILE,NDCIEN,2)=NDC1PRE
+29 SET NDCAR(FILE,NDCIEN,3)=NDC1POST
End DoDot:1
+30 IF NDC2PRE'=NDC2POST
Begin DoDot:1
+31 SET NDCAR(FILE,NDCIEN,4)=NDC2PRE
+32 SET NDCAR(FILE,NDCIEN,5)=NDC2POST
End DoDot:1
+33 DO FILE^DIE(,"NDCAR")
+34 ;
+35 KILL NDCAR
+36 ;
+37 QUIT
+38 ;
NDCHLP2 ; Invalid NDC entry
+1 ;
+2 WRITE !!,"NDC is not valid."
+3 ;
NDCHLP ; Display list of valid NDCs
+1 ;
+2 SET PSSI=""
+3 WRITE !,"Select from one of the following valid NDC(s) or enter ^ to exit:",!
+4 FOR
SET PSSI=$ORDER(NDCAR(2,PSSI))
if PSSI=""
QUIT
Begin DoDot:1
+5 WRITE !?3,PSSI_" - "_NDCAR(2,PSSI)
End DoDot:1
+6 QUIT
+7 ;
DELETE() ; Confirm Deletion of NDC
+1 ;
+2 NEW DIR,DIRUT,X,Y
+3 SET DIR(0)="Y"
+4 SET DIR("A")=" SURE YOU WANT TO DELETE"
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT 0
+8 QUIT Y
