PXVNDC ;BIR/ADM - UTILITIES RELATED TO NDC ;03/17/2016
;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
;
Q
NDC(PXVZ) ; called from input transform and executable help on field #.18 in file #9999999.41
N PXNDC,PXVIN,PXVDC,PXVX,PXVLST,PXVOUT
S (PXNDC,PXVOUT)=0,PXVIN="",PXVLST="PXVLST"
S PXVX=$S($G(DIY):DIY,1:PXVZ)
S:$E(PXVZ)="`" PXVX=$E(PXVZ,2,99)
I +$G(PXVX) D K:$D(PXVLST) ^TMP($J,PXVLST) I PXVOUT Q PXNDC
.D ALL^PSN5067(PXVX,,DT,PXVLST) I $P($G(^TMP($J,PXVLST,0)),"^")=-1 S PXVOUT=1 Q
.S PXVIN=$P($G(^TMP($J,PXVLST,PXVX,7)),"^")
I PXVIN=""!(PXVIN>DT)&($P($$DRGCLS^PSNAPIS(PXVX),"^",2)="IM000") S PXNDC=1
Q PXNDC
;
NDCOUT(PXVN) ; output transform on NDC CODE (VA) field (#.18) in file #9999999.41
N PXVARAY,PXVOUT,PXV7
I PXVN="" S PXVOUT="" Q PXVOUT
D CIRN^PSNAPIS(PXVN,.PXVARAY)
S PXV7=$G(PXVARAY(7))
S PXVOUT=$P(PXV7,"^")_" "_$P(PXV7,"^",3)
Q PXVOUT
;
P01 ; input transform logic for field #.18 in file 9999999.41
N SCR
S SCR="I $$NDC^PXVNDC(X)"
D INTRAN^PSNAPIS(SCR)
Q
QUEST ; "?" or "??" help for field #.18 in file 9999999.41
N SCR
S SCR="I $$NDC^PXVNDC(X)"
D QLIST^PSNAPIS(SCR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVNDC 1167 printed Nov 22, 2024@17:41:46 Page 2
PXVNDC ;BIR/ADM - UTILITIES RELATED TO NDC ;03/17/2016
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
+2 ;
+3 QUIT
NDC(PXVZ) ; called from input transform and executable help on field #.18 in file #9999999.41
+1 NEW PXNDC,PXVIN,PXVDC,PXVX,PXVLST,PXVOUT
+2 SET (PXNDC,PXVOUT)=0
SET PXVIN=""
SET PXVLST="PXVLST"
+3 SET PXVX=$SELECT($GET(DIY):DIY,1:PXVZ)
+4 if $EXTRACT(PXVZ)="`"
SET PXVX=$EXTRACT(PXVZ,2,99)
+5 IF +$GET(PXVX)
Begin DoDot:1
+6 DO ALL^PSN5067(PXVX,,DT,PXVLST)
IF $PIECE($GET(^TMP($JOB,PXVLST,0)),"^")=-1
SET PXVOUT=1
QUIT
+7 SET PXVIN=$PIECE($GET(^TMP($JOB,PXVLST,PXVX,7)),"^")
End DoDot:1
if $DATA(PXVLST)
KILL ^TMP($JOB,PXVLST)
IF PXVOUT
QUIT PXNDC
+8 IF PXVIN=""!(PXVIN>DT)&($PIECE($$DRGCLS^PSNAPIS(PXVX),"^",2)="IM000")
SET PXNDC=1
+9 QUIT PXNDC
+10 ;
NDCOUT(PXVN) ; output transform on NDC CODE (VA) field (#.18) in file #9999999.41
+1 NEW PXVARAY,PXVOUT,PXV7
+2 IF PXVN=""
SET PXVOUT=""
QUIT PXVOUT
+3 DO CIRN^PSNAPIS(PXVN,.PXVARAY)
+4 SET PXV7=$GET(PXVARAY(7))
+5 SET PXVOUT=$PIECE(PXV7,"^")_" "_$PIECE(PXV7,"^",3)
+6 QUIT PXVOUT
+7 ;
P01 ; input transform logic for field #.18 in file 9999999.41
+1 NEW SCR
+2 SET SCR="I $$NDC^PXVNDC(X)"
+3 DO INTRAN^PSNAPIS(SCR)
+4 QUIT
QUEST ; "?" or "??" help for field #.18 in file 9999999.41
+1 NEW SCR
+2 SET SCR="I $$NDC^PXVNDC(X)"
+3 DO QLIST^PSNAPIS(SCR)
+4 QUIT
