- 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 Jan 18, 2025@03:32: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