- PSNOUT ;BIR/CCH&WRT-output transform routine ; 10/31/98 19:19
- ;;4.0;NATIONAL DRUG FILE;**2,82,92,492**;30 Oct 98;Build 27
- INGRED ; output transform for ingredient
- K X,LIST,^TMP($J,"PSNING") S K=PSNFNM,X=$$PSJING^PSNAPIS(,K,.LIST),STOP=X D ING0,ING00 F PSNXZ=0:0 S PSNXZ=$O(^TMP($J,"PSNING",PSNXZ)) Q:PSNXZ'?1.N S INGT=^TMP($J,"PSNING",PSNXZ) D DISP,BREAK
- K ^TMP($J,"PSNING")
- Q
- DISP W !?5,$P(INGT,"^",1)_" "_$P(INGT,"^",2)_" "_$P(INGT,"^",3)
- Q
- BREAK I PSNXZ#7=0,STOP'=7 W !,"Press ANY key to continue Ingredient listing: " R PSNCON:DTIME S:'$T PSNCON="^" Q:PSNCON="^"
- Q
- ING0 F INT=0:0 S INT=$O(LIST(INT)) Q:'INT S ^TMP($J,"PSNING",$P(LIST(INT),"^",2),INT)=LIST(INT)
- Q
- ING00 S PSNRAN=0 S IN="" F S IN=$O(^TMP($J,"PSNING",IN)) Q:IN="" D ING000
- Q
- ING000 F IN1=0:0 S IN1=$O(^TMP($J,"PSNING",IN,IN1)) Q:'IN1 D ARRAY
- Q
- ARRAY S PSNRAN=PSNRAN+1 S ^TMP($J,"PSNING",PSNRAN)=IN_"^"_$P(LIST(IN1),"^",3)_"^"_$P(LIST(IN1),"^",4)
- Q
- FORM ; output transform for va product code
- I $D(^PSDRUG(D0,"ND")) S PSNLOCL=^PSDRUG(D0,"ND")
- Q:'$O(^PSNDF(50.68,0)) Q:'$D(PSNLOCL) Q:$P(PSNLOCL,"^",1)']""
- S PSNDF=$P(PSNLOCL,"^",1),PSNPTR=$P(PSNLOCL,"^",3)
- S Y=$P(^PSNDF(50.68,PSNPTR,0),"^",1) K PSNLOCL,PSNDF,PSNPTR Q
- Q
- REACT ; code for reactivation of inactive drug in local drug file
- I $D(^PSDRUG(DA,"ND")) I $P(^PSDRUG(DA,"ND"),"^",2)]"" W !!,"points to ",$P(^("ND"),"^",2)," in the National Drug File."
- REACT1 I $O(^PSNDF(50.6,0)) S XX=$S('$D(^PSDRUG(DA,"ND")):1,1:$P(^("ND"),"^",2)="") D
- .I XX S (PSNB,PSNDRG,Z9)=DA,PSNLOC=$P(^PSDRUG(PSNB,0),"^",1) K ^PSNTRAN(PSNB) D GONE^PSNDRUG,BLDIT^PSNCOMP S DA=Z9,PSEDIT=1 D CHK^PSNVFY,SET^PSNMRG,GONE^PSNDRUG K Z9,XX,PSEDIT
- Q
- PKSIZE ; output transform for package size
- I $D(^PS(50.609,PSNSIZE,0)) S PSNSZE=$P(^PS(50.609,PSNSIZE,0),"^",1)
- Q
- PKTYPE ; output transform for package type
- S PSNTPE=""
- I $D(^PS(50.608,PSNTYPE,0)) S PSNTPE=$P(^PS(50.608,PSNTYPE,0),"^",1)
- Q
- INGRED1 ; output transform for ingredient-used in NDF Info Report
- K LIST,X S K=FNM,X=$$PSJING^PSNAPIS(,K,.LIST) D INGRD1,INGRD2 K IN,VV,VVV
- Q
- INGRD1 K ^TMP($J,"PSNING") F INT=0:0 S INT=$O(LIST(INT)) Q:'INT S ^TMP($J,"PSNING",$P(LIST(INT),"^",2),INT)=LIST(INT)
- Q
- INGRD2 S IN="" F S IN=$O(^TMP($J,"PSNING",IN)) Q:IN="" S IN1=$O(^TMP($J,"PSNING",IN,0)) W !,?42,IN," ",$P(^TMP($J,"PSNING",IN,IN1),"^",3)," ",$P(^TMP($J,"PSNING",IN,IN1),"^",4)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNOUT 2400 printed Feb 18, 2025@23:50:46 Page 2
- PSNOUT ;BIR/CCH&WRT-output transform routine ; 10/31/98 19:19
- +1 ;;4.0;NATIONAL DRUG FILE;**2,82,92,492**;30 Oct 98;Build 27
- INGRED ; output transform for ingredient
- +1 KILL X,LIST,^TMP($JOB,"PSNING")
- SET K=PSNFNM
- SET X=$$PSJING^PSNAPIS(,K,.LIST)
- SET STOP=X
- DO ING0
- DO ING00
- FOR PSNXZ=0:0
- SET PSNXZ=$ORDER(^TMP($JOB,"PSNING",PSNXZ))
- if PSNXZ'?1.N
- QUIT
- SET INGT=^TMP($JOB,"PSNING",PSNXZ)
- DO DISP
- DO BREAK
- +2 KILL ^TMP($JOB,"PSNING")
- +3 QUIT
- DISP WRITE !?5,$PIECE(INGT,"^",1)_" "_$PIECE(INGT,"^",2)_" "_$PIECE(INGT,"^",3)
- +1 QUIT
- BREAK IF PSNXZ#7=0
- IF STOP'=7
- WRITE !,"Press ANY key to continue Ingredient listing: "
- READ PSNCON:DTIME
- if '$TEST
- SET PSNCON="^"
- if PSNCON="^"
- QUIT
- +1 QUIT
- ING0 FOR INT=0:0
- SET INT=$ORDER(LIST(INT))
- if 'INT
- QUIT
- SET ^TMP($JOB,"PSNING",$PIECE(LIST(INT),"^",2),INT)=LIST(INT)
- +1 QUIT
- ING00 SET PSNRAN=0
- SET IN=""
- FOR
- SET IN=$ORDER(^TMP($JOB,"PSNING",IN))
- if IN=""
- QUIT
- DO ING000
- +1 QUIT
- ING000 FOR IN1=0:0
- SET IN1=$ORDER(^TMP($JOB,"PSNING",IN,IN1))
- if 'IN1
- QUIT
- DO ARRAY
- +1 QUIT
- ARRAY SET PSNRAN=PSNRAN+1
- SET ^TMP($JOB,"PSNING",PSNRAN)=IN_"^"_$PIECE(LIST(IN1),"^",3)_"^"_$PIECE(LIST(IN1),"^",4)
- +1 QUIT
- FORM ; output transform for va product code
- +1 IF $DATA(^PSDRUG(D0,"ND"))
- SET PSNLOCL=^PSDRUG(D0,"ND")
- +2 if '$ORDER(^PSNDF(50.68,0))
- QUIT
- if '$DATA(PSNLOCL)
- QUIT
- if $PIECE(PSNLOCL,"^",1)']""
- QUIT
- +3 SET PSNDF=$PIECE(PSNLOCL,"^",1)
- SET PSNPTR=$PIECE(PSNLOCL,"^",3)
- +4 SET Y=$PIECE(^PSNDF(50.68,PSNPTR,0),"^",1)
- KILL PSNLOCL,PSNDF,PSNPTR
- QUIT
- +5 QUIT
- REACT ; code for reactivation of inactive drug in local drug file
- +1 IF $DATA(^PSDRUG(DA,"ND"))
- IF $PIECE(^PSDRUG(DA,"ND"),"^",2)]""
- WRITE !!,"points to ",$PIECE(^("ND"),"^",2)," in the National Drug File."
- REACT1 IF $ORDER(^PSNDF(50.6,0))
- SET XX=$SELECT('$DATA(^PSDRUG(DA,"ND")):1,1:$PIECE(^("ND"),"^",2)="")
- Begin DoDot:1
- +1 IF XX
- SET (PSNB,PSNDRG,Z9)=DA
- SET PSNLOC=$PIECE(^PSDRUG(PSNB,0),"^",1)
- KILL ^PSNTRAN(PSNB)
- DO GONE^PSNDRUG
- DO BLDIT^PSNCOMP
- SET DA=Z9
- SET PSEDIT=1
- DO CHK^PSNVFY
- DO SET^PSNMRG
- DO GONE^PSNDRUG
- KILL Z9,XX,PSEDIT
- End DoDot:1
- +2 QUIT
- PKSIZE ; output transform for package size
- +1 IF $DATA(^PS(50.609,PSNSIZE,0))
- SET PSNSZE=$PIECE(^PS(50.609,PSNSIZE,0),"^",1)
- +2 QUIT
- PKTYPE ; output transform for package type
- +1 SET PSNTPE=""
- +2 IF $DATA(^PS(50.608,PSNTYPE,0))
- SET PSNTPE=$PIECE(^PS(50.608,PSNTYPE,0),"^",1)
- +3 QUIT
- INGRED1 ; output transform for ingredient-used in NDF Info Report
- +1 KILL LIST,X
- SET K=FNM
- SET X=$$PSJING^PSNAPIS(,K,.LIST)
- DO INGRD1
- DO INGRD2
- KILL IN,VV,VVV
- +2 QUIT
- INGRD1 KILL ^TMP($JOB,"PSNING")
- FOR INT=0:0
- SET INT=$ORDER(LIST(INT))
- if 'INT
- QUIT
- SET ^TMP($JOB,"PSNING",$PIECE(LIST(INT),"^",2),INT)=LIST(INT)
- +1 QUIT
- INGRD2 SET IN=""
- FOR
- SET IN=$ORDER(^TMP($JOB,"PSNING",IN))
- if IN=""
- QUIT
- SET IN1=$ORDER(^TMP($JOB,"PSNING",IN,0))
- WRITE !,?42,IN," ",$PIECE(^TMP($JOB,"PSNING",IN,IN1),"^",3)," ",$PIECE(^TMP($JOB,"PSNING",IN,IN1),"^",4)
- +1 QUIT