PSNEWCLS.m

PSNEWCLS ;BIR/DMA-NOTIFY OF CLASS CHANGES ; 17 Jun 2009  7:08 AM

 ;;4.0; NATIONAL DRUG FILE;**176,100**; 30 Oct 98;Build 5

 ;

 ;Reference to UPDATE^GMRAUTL2 supported by DBIA #4667

 ;

 K ^TMP("PSN1",$J),^TMP("PSNN",$J) N CLASS,DA,DIE,DR,LIN,NC,OC,PR,PSDA,PSNG,PSNGD,PSNK,X,XMDUZ,XMSUB,XMTEXT,XMY

 S DA=0 F  S DA=$O(^TMP("PSN",$J,DA)) Q:'DA  S PSDA=^(DA,0) D

 .K CLASS S CLASS("D",$P(PSDA,"^",2))="",CLASS("A",$P(PSDA,"^",3))="",X=$P(PSDA,"^",4)_";PSNDF(50.6,^"_$P(^PSNDF(50.6,$P(PSDA,"^",4),0),"^")

 .S PSNG=$P(^PSNDF(50.68,DA,0),"^",2),PSNK=0,PSNGD=0 F  S PSNGD=$O(^PSNDF(50.6,"APRO",PSNG,PSNGD)) Q:'PSNGD  I $P(^PSNDF(50.68,PSNGD,3),"^")=$P(PSDA,"^",2) S PSNK=1 Q

 .I PSNK K CLASS("D")

 .I $T(UPDATE^GMRAUTL2)]"" D UPDATE^GMRAUTL2(X,,.CLASS)

 .S PR=$P(^PSNDF(50.68,+PSDA,0),"^"),OC=$P(^PS(50.605,$P(PSDA,"^",2),0),"^"),NC=$P(^PS(50.605,$P(PSDA,"^",3),0),"^"),^TMP("PSN1",$J,PR_"^"_OC_"^"_NC)=""

 ;

 S LIN=1,DA="" F  S DA=$O(^TMP("PSN1",$J,DA)) Q:DA=""  S ^TMP("PSNN",$J,LIN,0)="Product: "_$P(DA,"^"),^TMP("PSNN",$J,LIN+1,0)="Old Class: "_$P(DA,"^",2),^TMP("PSNN",$J,LIN+2,0)="New Class:"_$P(DA,"^",3),^TMP("PSNN",$J,LIN+3,0)=" ",LIN=LIN+4

 ;

 K XMY S XMY(DUZ)="",XMY("G.NDF DATA@"_^XMB("NETNAME"))="" S DA=0 F  S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA  S XMY(DA)=""

 S XMDUZ="NDF MANAGER",XMSUB="Products with changed classes",XMTEXT="^TMP(""PSNN"",$J," D ^XMD

 ;

 K CLASS,DA,DIE,DR,LIN,NC,OC,PR,PSDA,PSNG,PSNGD,PSNK,X,XMDUZ,XMSUB,XMTEXT,XMY,^TMP("PSN1",$J),^TMP("PSNN",$J) Q 

PSNEWCLS  ;BIR/DMA-NOTIFY OF CLASS CHANGES ; 17 Jun 2009  7:08 AM

 +1       ;;4.0; NATIONAL DRUG FILE;**176,100**; 30 Oct 98;Build 5

 +2       ;

 +3       ;Reference to UPDATE^GMRAUTL2 supported by DBIA #4667

 +4       ;

 +5        KILL ^TMP("PSN1",$JOB),^TMP("PSNN",$JOB)

           NEW CLASS,DA,DIE,DR,LIN,NC,OC,PR,PSDA,PSNG,PSNGD,PSNK,X,XMDUZ,XMSUB,XMTEXT,XMY

 +6        SET DA=0

           FOR 

               SET DA=$ORDER(^TMP("PSN",$JOB,DA))

               IF 'DA

                   QUIT 

               SET PSDA=^(DA,0)

               Begin DoDot:1

 +7                KILL CLASS

                   SET CLASS("D",$PIECE(PSDA,"^",2))=""

                   SET CLASS("A",$PIECE(PSDA,"^",3))=""

                   SET X=$PIECE(PSDA,"^",4)_";PSNDF(50.6,^"_$PIECE(^PSNDF(50.6,$PIECE(PSDA,"^",4),0),"^")

 +8                SET PSNG=$PIECE(^PSNDF(50.68,DA,0),"^",2)

                   SET PSNK=0

                   SET PSNGD=0

                   FOR 

                       SET PSNGD=$ORDER(^PSNDF(50.6,"APRO",PSNG,PSNGD))

                       IF 'PSNGD

                           QUIT 

                       IF $PIECE(^PSNDF(50.68,PSNGD,3),"^")=$PIECE(PSDA,"^",2)

                           SET PSNK=1

                           QUIT 

 +9                IF PSNK

                       KILL CLASS("D")

 +10               IF $TEXT(UPDATE^GMRAUTL2)]""

                       DO UPDATE^GMRAUTL2(X,,.CLASS)

 +11               SET PR=$PIECE(^PSNDF(50.68,+PSDA,0),"^")

                   SET OC=$PIECE(^PS(50.605,$PIECE(PSDA,"^",2),0),"^")

                   SET NC=$PIECE(^PS(50.605,$PIECE(PSDA,"^",3),0),"^")

                   SET ^TMP("PSN1",$JOB,PR_"^"_OC_"^"_NC)=""

               End DoDot:1

 +12      ;

 +13       SET LIN=1

           SET DA=""

           FOR 

               SET DA=$ORDER(^TMP("PSN1",$JOB,DA))

               IF DA=""

                   QUIT 

               SET ^TMP("PSNN",$JOB,LIN,0)="Product: "_$PIECE(DA,"^")

               SET ^TMP("PSNN",$JOB,LIN+1,0)="Old Class: "_$PIECE(DA,"^",2)

               SET ^TMP("PSNN",$JOB,LIN+2,0)="New Class:"_$PIECE(DA,"^",3)

               SET ^TMP("PSNN",$JOB,LIN+3,0)=" "

               SET LIN=LIN+4

 +14      ;

 +15       KILL XMY

           SET XMY(DUZ)=""

           SET XMY("G.NDF DATA@"_^XMB("NETNAME"))=""

           SET DA=0

           FOR 

               SET DA=$ORDER(^XUSEC("PSNMGR",DA))

               IF 'DA

                   QUIT 

               SET XMY(DA)=""

 +16       SET XMDUZ="NDF MANAGER"

           SET XMSUB="Products with changed classes"

           SET XMTEXT="^TMP(""PSNN"",$J,"

           DO ^XMD

 +17      ;

 +18       KILL CLASS,DA,DIE,DR,LIN,NC,OC,PR,PSDA,PSNG,PSNGD,PSNK,X,XMDUZ,XMSUB,XMTEXT,XMY,^TMP("PSN1",$JOB),^TMP("PSNN",$JOB)

           QUIT