Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSNPPSI2

PSNPPSI2.m

Go to the documentation of this file.
  1. PSNPPSI2 ;HP/MJE-PPSN update NDF data for parsing DATAN records ; 05 Mar 2014 1:20 PM
  1. ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
  1. ;Reference to ^DD supported by DBIA #1258
  1. ;
  1. Q
  1. ;
  1. ;This routine parses DATAN records which are new entries other than .01 fields to the NDF files
  1. DATAN ;
  1. K FDA,^TMP("PSN OLDINGRED",$J),^TMP("PSN ADDINGRED",$J),^TMP("PSN DELINGRED",$J)
  1. S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="DATAN",PSNTMPN="DATAN"
  1. D UPDATE^DIE("","FDA","CTRLIEN")
  1. K FDA,SROOT
  1. N OFLDS,OIENS,OLDNDF,MIENS,MFLDS,JJJJ,PSNVAPD,OINGRED,XFILE,XFLDS,PSNINGRED
  1. D CTRLFILE^PSNPPSMS(0)
  1. D CTRLSS^PSNPPSMS(0)
  1. D CTRLIEN^PSNPPSMS(0)
  1. S FILE=0,GROOT=$NA(^TMP("PSN PPSN PARSED",$J,"DATAN"))
  1. ;load new multiple entries next
  1. F S FILE=$O(@GROOT@(FILE)) Q:'FILE D CTRLFILE^PSNPPSMS(FILE) S ROOT=$$ROOT^DILFD(FILE) I ROOT]"" S GROOT1=$NA(@GROOT@(FILE)) F JJ=1:2 Q:'$D(@GROOT1@(JJ)) D
  1. .S (DIA,NEW)=""
  1. .S DIA=@GROOT1@(JJ) I $G(@GROOT1@(JJ+1))]"" S NEW=@GROOT1@(JJ+1)
  1. .I FILE=50.68 S ^TMP("PSN PPSN PARSED",$J,"AE_PRODUCTS",+DIA)="" S:$P(DIA,"^",3)=.01 ^TMP("PSN PPSN PARSED",$J,"NEW PRODUCTS",+DIA)=""
  1. .D CTRLSS^PSNPPSMS($TR(GROOT1,"^")_","_JJ)
  1. .I $G(PSNMULTI) D
  1. ..S (MIENS,MFLDS)="",MIENS=$P(DIA,"^")_",",MFLDS=$P(DIA,"^",3)
  1. ..I MFLDS'=""&($P(NEW,"^")'=MIENS) S PSNMULTI=0,^TMP("PSN PPSN.WPXRF",$J,FILE,OIENS,OFLDS)=""
  1. .S IENS=$P(DIA,"^")_",",FLDS=$P(DIA,"^",3),ROOT=FILE K FDA,IEN
  1. .I FILE=50.68,($P(DIA,"^",3)="14,.01") D Q:NEW["DELETE"
  1. ..I '$D(^TMP("PSN OLDINGRED",$J,$P($P(DIA,"^"),","))) S OINGRED=0 F S OINGRED=$O(^PSNDF(50.68,$P($P(DIA,"^"),","),2,OINGRED)) Q:OINGRED="" S ^TMP("PSN OLDINGRED",$J,$P($P(DIA,"^"),","),OINGRED)=""
  1. ..D:'$D(^TMP("PSNINGRED",$J,$P($P(DIA,"^"),","))) AIDEL($P($P(DIA,"^"),",")) S ^TMP("PSNINGRED",$J,$P($P(DIA,"^"),","))=""
  1. .I PSNPS="N",FILE=50.68 D NDFK^PSNPPSNK D
  1. ..I $P(DIA,"^",3)=31 D
  1. ...K ORD
  1. ...S ORD=NEW
  1. ...S ^TMP("PSN PPSN PARSED",$J,"POST_RUN",5000.608,FILE,IENS,FLDS)=ORD
  1. .I FILE=50.68 D UNMATCH
  1. .;
  1. .I PSNPS="N" D
  1. ..;I FILE=50.416 D INGRED^PSNPPSNK
  1. ..I FILE=56 D 56^PSNPPSMS(FILE,DIA,NEW,PSNTMPN)
  1. .;
  1. .K RES1,RES2,RES3
  1. .I '$G(PSNMULTI) D FIELD^DID(FILE,FLDS,"","TYPE","RES1") ;I $G(RES1("TYPE"))'="WORD-PROCESSING" S PSNMULTI=0
  1. .I $G(RES1("TYPE"))="WORD-PROCESSING"!$G(PSNMULTI) D Q
  1. ..I '$G(PSNMULTI) D
  1. ...S MJJ=JJ,OIENS=IENS,OFLDS=FLDS
  1. ...I $D(^TMP("PSN PPSN.WPXRF",$J,FILE,IENS,FLDS)) K ^TMP("PSN PPSN.WP",$J,FILE,OIENS,OFLDS),^TMP("PSN PPSN.WPXRF",$J,FILE,IENS,FLDS)
  1. ...;Set 5000 file for word processing fields
  1. ...S PSNWP=$$GET1^DID(FILE,"","","GLOBAL NAME")_$P(DIA,"^")_"," ;"PSNDF(FILE,"_IENS_",1)"
  1. ...D FIELD^DID(FILE,FLDS,"Z","GLOBAL SUBSCRIPT LOCATION","RES2")
  1. ...S RES3="",RES3=$P(RES2("GLOBAL SUBSCRIPT LOCATION"),";")
  1. ...S PSNWP=PSNWP_$S(RES3?1AN.AN:""""_RES3_"""",1:RES3)_")"
  1. ...I PSNPS="N",'$D(^NDFK(5000,1,4,"B",PSNWP)) S X=$O(^NDFK(5000,1,4," "),-1)+1,^(X,0)=PSNWP,^NDFK(5000,1,4,"B",PSNWP,X)=""
  1. ..;
  1. ..I '$P(DIA,"^",3) S ^TMP("PSN PPSN.WP",$J,FILE,OIENS,OFLDS,MJJ)=$$STRIP^PSNPPSNU(DIA),MJJ=MJJ+1
  1. ..I '$P(NEW,"^",3) S ^TMP("PSN PPSN.WP",$J,FILE,OIENS,OFLDS,MJJ)=$$STRIP^PSNPPSNU(NEW),PSNMULTI=1,MJJ=MJJ+1
  1. ..I $P(NEW,"^",3)'="" S JJ=JJ-1
  1. .;
  1. .;get multiple info
  1. .I FLDS["," D
  1. ..I FILE=50.68,$P($P(DIA,"^",3),",")=43 D MULTIPLE Q
  1. ..;it should, but
  1. ..S LI=$P(DIA,"^",3) F J=1:1:$L(LI,",")-1 S ROOT=+$P(^DD(ROOT,+$P(LI,",",J),0),"^",2)
  1. ..S LI=$P(DIA,"^"),IENS="" F J=$L(LI,","):-1:1 S IENS=IENS_$P(LI,",",J)_",",^TMP("PSN PPSN PARSED",$J,"AE_PRODUCTS",$P(LI,",",J))=""
  1. ..S XFLDS=$P(FLDS,",",$L(FLDS,",")-1) I $G(XFLDS)'="" S XFILE=+$P(^DD(FILE,XFLDS,0),"^",2) S:$G(XFILE)="" XFILE=FILE
  1. ..S FLDS=$P(FLDS,",",$L(FLDS,","))
  1. .S DA=+IENS
  1. .D CTRLIEN^PSNPPSMS(IENS)
  1. .;
  1. .I FILE=50.68,$P($P(DIA,"^",3),",")=43 Q
  1. .;
  1. .;delete copay tiers if needed
  1. .I ROOT=50.6845&($P($P(DIA,"^"),",",2)=1&($P(DIA,"^",3)="45,.01")) D CPTIERD($P(IENS,",",2)) Q:NEW="DELETED"
  1. .;
  1. .I ROOT=50.6068&($P($P(DIA,"^"),",",2)=1&($P(DIA,"^",3)="8,.01")) D DOSFORUD($P(IENS,",",2)) Q:NEW="DELETED" ;dosage form units #50.606
  1. .I ROOT=50.6069&($P($P(DIA,"^"),",",2)=1&($P(DIA,"^",3)="9,.01")) D DOSFORDD($P(IENS,",",2)) Q:NEW="DELETED" ;dispense units per dose #50.606
  1. .;
  1. .I $P(DIA,"^",3)="99.991,.01" D K FDA Q
  1. ..K FDA,ERROR
  1. ..S FDA(ROOT,"+"_IENS,FLDS)=NEW D UPDATE^DIE("","FDA","","ERROR") D ERROR^PSNPPSNU:$D(ERROR("DIERR")) K FDA
  1. .;
  1. .;edit single field
  1. .I $$GET1^DIQ(ROOT,IENS,FLDS)]"" S FDA(ROOT,IENS,.01)=NEW,IEN(DA)=DA D Q
  1. ..D UPDATE^DIE("","FDA","IEN","") K FDA D CTRLIEN^PSNPPSMS(IENS)
  1. .;
  1. .;set new multiple field
  1. .I $P(DIA,"^",3)["," D Q
  1. ..K DIC,FDA
  1. ..;I ROOT'[50.6843 S DA(1)=$P($P(DIA,"^"),",")
  1. ..S DA(1)=$P($P(DIA,"^"),","),DIC=$$ROOT^DILFD(ROOT,IENS,,1)
  1. ..S X=NEW,DIC(0)="L",DIC("DR")="S Y=0"
  1. ..I ROOT[50.6068!(ROOT[50.6069) S (DA,DINUM)=$P($P(DIA,"^"),",",2) ;this is in here until PPS-N fixes the IENS
  1. ..I ROOT[50.6845!(ROOT[50.6814) S DA=$P($P(DIA,"^"),",",2)
  1. ..I ROOT["50.68"&($P(DIA,"^",3)="14,.01"!($P(DIA,"^",3)="16,.01")!($P(DIA,"^",3)="45,.01")) S DINUM=DA
  1. ..K DD,DO D FILE^DICN I 'Y D ERROR2^PSNPPSNU(PSNTMPN,ROOT,IENS,DA,"Error setting new multiple entry")
  1. ..I ROOT[50.6845,(PSNATYP="N") D CPTIER^PSNPPSNK(DIA)
  1. .;
  1. .I $P(DIA,"^",3)="99.991,.02" D K FDA,ERROR Q
  1. ..S DA=999999999999 S DA=$O(^PS(FILE,+$P(DIA,"^"),"TERMSTATUS",DA),-1)
  1. ..I FILE=50.6!(FILE=50.68) S DA=999999999999 S DA=$O(^PSNDF(FILE,+$P(DIA,"^"),"TERMSTATUS",DA),-1)
  1. ..S $P(IENS,",",1)=DA,FDA(ROOT,IENS,.02)=NEW D UPDATE^DIE("","FDA","IEN","ERROR") D ERROR^PSNPPSNU:$D(ERROR("DIERR")) K FDA
  1. .;
  1. .;set new single field
  1. .K DIC,FDA
  1. .S DINUM=DA,X=NEW,DIC=ROOT,DIC(0)="L",DIC("DR")="S Y=0" K DD,DO D FILE^DICN I 'Y D ERROR2^PSNPPSNU(PSNTMPN,ROOT,IENS,DA,"Error new single field")
  1. .D CTRLIEN^PSNPPSMS(IENS)
  1. ;
  1. DATAN2 ;word processing fields
  1. S ERROR=0
  1. S JJ=0 F S JJ=$O(^TMP("PSNN",$J,JJ)) Q:'JJ S DA=$P(JJ,",",2),DA(1)=+JJ D
  1. . I '$D(^PSNDF(50.68,DA(1),0)) D ERROR2^PSNPPSNU(PSNTMPN,ROOT,IENS,DA(1),"VA PRODUCT entry does not exist.") Q
  1. . D ING^PSNXREF
  1. .;50.68 ADDED INGREDIENT 5000.508
  1. ;S ^TMP("PSN OLDINGRED",$J,PSNVAPD,CNT1)=""
  1. I PSNPS="N" S (PSNINGRED,PSNVAPD)="" D
  1. .;if ingredient remains on the product, then it wasn't deleted
  1. .F S PSNVAPD=$O(^TMP("PSN OLDINGRED",$J,PSNVAPD)) Q:PSNVAPD="" F S PSNINGRED=$O(^TMP("PSN OLDINGRED",$J,PSNVAPD,PSNINGRED)) Q:PSNINGRED="" D
  1. ..I '$D(^PSNDF(50.68,PSNVAPD,2,PSNINGRED,0)) S ^TMP("PSN DELINGRED",$J,PSNINGRED)=""
  1. .;if the ingredient was not one of the old ingredients then it was added
  1. .F S PSNVAPD=$O(^TMP("PSN OLDINGRED",$J,PSNVAPD)) Q:PSNVAPD="" S PSNINGRED=0 F S PSNINGRED=$O(^PSNDF(50.68,PSNVAPD,2,PSNINGRED)) Q:PSNINGRED="" D
  1. ..I '$D(^TMP("PSN OLDINGRED",$J,PSNVAPD,PSNINGRED)) S ^TMP("PSN ADDINGRED",$J,PSNINGRED)=""
  1. .;I PSNPS="N" S X=+$P(DIA,"^") I '$D(^NDFK(5000.508,"B",X)) S DIC=5000.508,DIC(0)="LMXZ" D FILE^DICN
  1. ;
  1. S FILE="" F S FILE=$O(^TMP("PSN PPSN.WP",$J,FILE)) Q:FILE="" D
  1. . S IENS="" F S IENS=$O(^TMP("PSN PPSN.WP",$J,FILE,IENS)) Q:IENS="" D
  1. .. S FLDS="" F S FLDS=$O(^TMP("PSN PPSN.WP",$J,FILE,IENS,FLDS)) Q:FLDS="" D
  1. ... K TMP,ERR
  1. ... S JJ=0 F S JJ=$O(^TMP("PSN PPSN.WP",$J,FILE,IENS,FLDS,JJ)) Q:'JJ D
  1. .... S TMP(JJ)=^TMP("PSN PPSN.WP",$J,FILE,IENS,FLDS,JJ)
  1. ... D WP^DIE(FILE,IENS,FLDS,"","TMP","ERR")
  1. K ^TMP("PSN PPSN.WP",$J)
  1. ;
  1. D DATAO^PSNPPSI3
  1. Q
  1. ;
  1. CPTIERD(PSNVAPN) ;copay tiers deleted
  1. N COPAYACT
  1. S CNT=0 F S CNT=$O(^PSNDF(50.68,PSNVAPN,10,CNT)) Q:CNT="" D
  1. . S DIK="^PSNDF(50.68,"_PSNVAPN_",10,",DA=CNT,DA(1)=PSNVAPN
  1. . D ^DIK
  1. S COPAYACT=0
  1. I PSNATYP="N" D COPNDFK
  1. Q
  1. ;
  1. COPNDFK ; define NDFK file 5000.93
  1. N X,DIC,DIE,DR,NDFKSEQ,PRIEN,NAME S NDFKSEQ="",PRIEN=PSNVAPN
  1. I '$D(^NDFK(5000.93,0)) S ^NDFK(5000.93,0)="COPAY TIERS SETTINGS CHANGES^5000.93P^0^0"
  1. S NAME=$$GET1^DIQ(50.68,PRIEN,.01,"E")
  1. S X=NAME,DIC=5000.93,DIC(0)="LMXZ" D ^DIC
  1. S DIE=DIC,DA=+Y K DIC
  1. S DR=".01///^S X=PRIEN;1///^S X="_COPAYACT ;Copay action - 0 = delete or 1 = add/edit
  1. D ^DIE
  1. Q
  1. ;
  1. DOSFORUD(PSNVAPN) ;dosage forms units deleted
  1. N DOSFORU
  1. S CNT=0 F S CNT=$O(^PS(50.606,PSNVAPN,"UNIT",CNT)) Q:CNT="" D
  1. . S DIK="^PS(50.606,"_PSNVAPN_","_"""UNIT"""_",",DA=CNT,DA(1)=PSNVAPN
  1. . D ^DIK
  1. S DOSFORU=0
  1. Q
  1. ;
  1. DOSFORDD(PSNVAPN) ;dispense units per dose deleted
  1. N DOSFORU
  1. S CNT=0 F S CNT=$O(^PS(50.606,PSNVAPN,"DUPD",CNT)) Q:CNT="" D
  1. . S DIK="^PS(50.606,"_PSNVAPN_","_"""DUPD"""_",",DA=CNT,DA(1)=PSNVAPN
  1. . D ^DIK
  1. S DOSFORU=0
  1. Q
  1. ;
  1. MULTIPLE ;There should only be one RxNorm entry and one RXCUI
  1. N DA,SROOT,MROOT,MLTCNT,DIC,DINUM,X,Y,DINUM,VAPRIEN,SS1,SS2,SS3,DLAYGO
  1. S LI=$P(DIA,"^",3),SROOT=ROOT,ROOT=50.68,MLTCNT="",VAPRIEN=$P($P(DIA,"^"),",")
  1. ;handles a multiple and a multiple within a multiple
  1. I FILE=50.68,$P(DIA,"^",3)="43,.01",(NEW["DELETE"!(NEW="")) D RXNORMD1(VAPRIEN) Q
  1. I FILE=50.68,$P(DIA,"^",3)="43,.02,.01",(NEW["DELETE"!(NEW="")) D RXNORMD1(VAPRIEN) Q
  1. I PSNTMPN="DATAN" D ;DATAN records are new entries and should not be already defined
  1. .I FILE=50.68,$P(DIA,"^",3)="43,.01" D:$D(^PSNDF(50.68,VAPRIEN,11,0)) RXNORMD1(VAPRIEN) Q
  1. .I FILE=50.68,$P(DIA,"^",3)="43,.02,.01" D
  1. ..S SS1="",SS1=$O(^PSNDF(50.68,VAPRIEN,11,"B","RxNorm",SS1))
  1. ..Q:SS1=""
  1. ..S (SS3,SS2)=0 F S SS2=$O(^PSNDF(50.68,VAPRIEN,11,SS1,1,SS2)) Q:'SS2 S SS3=1
  1. ..Q:'SS3
  1. ..D RXNORMD2(VAPRIEN)
  1. ;ROOT=top of file, and then sets root to the multiple root
  1. F J=1:1:$L(LI,",")-1 S ROOT=+$P(^DD(ROOT,+$P(LI,",",J),0),"^",2)
  1. S MROOT=ROOT
  1. S LI=$P(DIA,"^"),IENS="" F J=$L(LI,","):-1:1 S IENS=IENS_$P(LI,",",J)_",",^TMP("PSN PPSN PARSED",$J,"AE_PRODUCTS",$P(LI,",",J))=""
  1. F J=1:1 Q:$P(LI,",",J)="" S MLTCNT=MLTCNT+1
  1. S XFLDS=$P(FLDS,",",$L(FLDS,","))
  1. I PSNTMPN="DATAO" D EDTMULT Q
  1. I MLTCNT=2 S FLDS=$P(FLDS,",",MLTCNT) D
  1. .K DIC,DA S DA(1)=VAPRIEN,X=VAPRIEN,DIC="^PSNDF(50.68,"_VAPRIEN_",11,",DIC(0)="ZQL",DLAYGO=50.6843,X=NEW D ^DIC
  1. I MLTCNT>2 S FLDS=$P(FLDS,",",MLTCNT-1) D
  1. .K DIC,DA S DA(1)=VAPRIEN,X=VAPRIEN,DIC="^PSNDF(50.68,"_VAPRIEN_",11,",DIC(0)="ZQ",X="RxNorm" D ^DIC
  1. .I +$G(Y) S DA(1)=+Y,DA(2)=VAPRIEN
  1. .I DA(1)="" D ERROR2^PSNPPSNU(PSNTMPN,MROOT,IENS,DA,"Error setting new multiple entry - top level multiple is not defined")
  1. .K DIC,Y S X=DA(1),DIC="^PSNDF(50.68,"_VAPRIEN_",11,"_DA(1)_",1,",DIC(0)="ZQL",DLAYGO=50.68431,X=NEW D ^DIC
  1. .I Y=-1!(+Y="") D ERROR2^PSNPPSNU(PSNTMPN,MROOT,IENS,DA,"Error setting new multiple entry - top level multiple is not defined") Q
  1. .S DA=+Y,DIE=DIC K DIC S DR=".01///"_NEW D ^DIE K DIE,DR,DA,Y
  1. Q
  1. ;
  1. EDTMULT ;edit existing multiple entry other than .01 field
  1. K DIC,DA S DA(1)=VAPRIEN,X=VAPRIEN,DIC="^PSNDF(50.68,"_VAPRIEN_",11,",DIC(0)="ZQ",X="RxNorm" D ^DIC
  1. I Y=-1!(+Y="") D ERROR2^PSNPPSNU(PSNTMPN,MROOT,IENS,DA,"Error editing RxNorm multiple - top level multiple is not defined") Q
  1. S DA(1)=+Y,DA(2)=VAPRIEN
  1. S DA=0,DA=$O(^PSNDF(50.68,6173,11,3,""),-1)
  1. I DA=0!(DA="") D ERROR2^PSNPPSNU(PSNTMPN,MROOT,IENS,DA,"Error editing RxNorm multiple - multiple is not defined")
  1. S DIE=DIC,IENS=DA_","_DA(1)_","_DA(2)_","
  1. S XPATH=$P(^DD(ROOT,.01,0),"^",3),ROOT3="^"_XPATH_DA(1)_",2,"
  1. K FDA,ERROR S FDA(ROOT,IENS,XFLDS)=NEW D UPDATE^DIE("","FDA",DA,"ERROR")
  1. S ROOT=SROOT
  1. Q
  1. ;
  1. RXNORMD1(PSNVAPN) ;RxNorm deleted
  1. N CNT,CNT2,DIK,DA,X
  1. S CNT=0 F S CNT=$O(^PSNDF(50.68,PSNVAPN,11,CNT)) Q:CNT'?1N.N D
  1. .S X="",X=$G(^PSNDF(50.68,PSNVAPN,11,CNT,0))
  1. .Q:X=""
  1. .Q:X'="RxNorm"
  1. .S DIK="^PSNDF(50.68,"_PSNVAPN_",11,",DA=CNT,DA(1)=PSNVAPN
  1. .D ^DIK
  1. Q
  1. ;
  1. RXNORMD2(PSNVAPN) ;RxNorm deleted
  1. N CNT,CNT2,DIK,DA,X,OVAL
  1. S (CNT2,CNT)=0 F S CNT=$O(^PSNDF(50.68,PSNVAPN,11,CNT)) Q:CNT'?1N.N F S CNT2=$O(^PSNDF(50.68,PSNVAPN,11,CNT,1,CNT2)) Q:CNT2'?1N.N D
  1. .S X="",X=$G(^PSNDF(50.68,PSNVAPN,11,CNT,1,CNT2,0))
  1. .Q:X=""
  1. .S OVAL=X,X=NEW
  1. .S DIK="^PSNDF(50.68,"_PSNVAPN_",11,"_CNT_",1,",DA=CNT2,DA(1)=CNT,DA(2)=PSNVAPN
  1. .D ^DIK
  1. .K ^PSNDF(50.68,PSNVAPN,11,CNT,CNT2,"B",OVAL)
  1. Q
  1. ;
  1. UNMATCH ;DRUGS TO UNMATCH
  1. N DIAFLD,OLDGEN
  1. S (DIAFLD,OLDGEN)="",DIAFLD=$P(DIA,"^",3)
  1. I DIAFLD=.05!(DIAFLD=1)!(DIAFLD=2)!(DIAFLD=3)!(DIAFLD=5)!(DIAFLD=6)!(DIAFLD=8) D
  1. .Q:$D(^TMP("PSN PPSN PARSED",$J,"NEW PRODUCTS",+DIA))
  1. .S ^TMP("PSN PPSN PARSED",$J,"PRODUCTS TO UNMATCH",$P(DIA,"^"))=""
  1. .D SETPROD
  1. Q
  1. ;
  1. SETPROD ;
  1. Q:PSNPS'="N"
  1. Q:$D(^NDFK(5000.2,"B",$P(DIA,"^")))
  1. S (DINUM,X)=$P(DIA,"^"),DIC=5000.2,DIC(0)="LMXZ" D FILE^DICN
  1. Q
  1. ;
  1. AIDEL(PSNVAPD) ; active ingredients deleted
  1. N CNT1,DA,DINUM,X
  1. S CNT1=0 F S CNT1=$O(^PSNDF(50.68,PSNVAPD,2,CNT1)) Q:CNT1="" D
  1. .S DIK="^PSNDF(50.68,"_PSNVAPD_",2,",DA=CNT1,DA(1)=PSNVAPD D ^DIK
  1. Q