Routine: ONCOPMP

ONCOPMP ;Hines OIFO/GWB - PRINT MULTIPLE ABSTRACTS ;12/16/99

 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8

PRT1 ;QA ABSTRACT

 S FLDS="[ONCQA]",(FR,TO)=NUMBER,BY="@NUMBER",DIC="^ONCO(165.5,",L=0

 D EN1^DIP

PRT2 ;SET VARIABLES AND @PRINT

 K DXS S DIOEND="S DN=1,D0=ONCODA F XI=50:1:58 K DXS D @(""^ONCOY""_XI)"

 S FLDS="[ONCOY49]",FR=NUMBER,TO=NUMBER,BY="@NUMBER",DIC="^ONCO(165.5,",L=0 D EN1^DIP

PRT3 ;Report 3

 S ONCOIEN=ONCODA D MULT^ONCOPA1

 ; K DXS S DIOEND="S DN=1,D0=ONCODA F XI=2:1:11 K DXS D @(""^ONCOX""_XI) K DXS"

 ; S FLDS="[ONCOX1]",FR=NUMBER,TO=NUMBER,BY="@NUMBER",DIC="^ONCO(165.5,",L=0 D EN1^DIP

PRT4 ;Report 4

 N XD0

 S FLDS="[ONCO XINCIDENCE RPRT]",(FR,TO)=NUMBER,BY="@NUMBER",DIC="^ONCO(165.5,",L=0 D EN1^DIP

 ;QA FORM

8 S DIWF=$S($G(ESPD)=1:"^ONCO(160.2,9,1,",1:"^ONCO(160.2,8,1,")

 S DIWF(1)="165.5",BY="NUMBER",(FR,TO)=ONCODA S TMPIO=IO W !! D EN2^DIWF S IOP=ONCOION D ^%ZIS

CK ;Check entry TO PREVENT DELETION

 I DUZ=231,DUZ(2)=10688 Q  ;    package developer can kill

 I DA>3 K ^ONCO(160.2,"B",$E(X,1,30),DA) Q

 W !!?5,"CANNOT DELETE THIS ENTRY" ;TO prevent deletion of exported entries.

H G ^XUSCLEAN ;HALT

EX ;EXIT

 K DIC,DIR,ONCOXD0,ONCOXD1,ONCOS,DIOEND,FR,TO,BY,L,^TMP("ONCO",$J)

 D ^%ZISC

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOPMP   1287     printed  Mar 13, 2025@21:30:11                                                                                                                                                                                                     Page 2

ONCOPMP   ;Hines OIFO/GWB - PRINT MULTIPLE ABSTRACTS ;12/16/99

 +1       ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8

 +2       ;

PRT1      ;QA ABSTRACT

 +1        SET FLDS="[ONCQA]"

           SET (FR,TO)=NUMBER

           SET BY="@NUMBER"

           SET DIC="^ONCO(165.5,"

           SET L=0

 +2        DO EN1^DIP

 +3        QUIT

 +4       ;

PRT2      ;SET VARIABLES AND @PRINT

 +1        KILL DXS

           SET DIOEND="S DN=1,D0=ONCODA F XI=50:1:58 K DXS D @(""^ONCOY""_XI)"

 +2        SET FLDS="[ONCOY49]"

           SET FR=NUMBER

           SET TO=NUMBER

           SET BY="@NUMBER"

           SET DIC="^ONCO(165.5,"

           SET L=0

           DO EN1^DIP

 +3        QUIT

PRT3      ;Report 3

 +1        SET ONCOIEN=ONCODA

           DO MULT^ONCOPA1

 +2       ; K DXS S DIOEND="S DN=1,D0=ONCODA F XI=2:1:11 K DXS D @(""^ONCOX""_XI) K DXS"

 +3       ; S FLDS="[ONCOX1]",FR=NUMBER,TO=NUMBER,BY="@NUMBER",DIC="^ONCO(165.5,",L=0 D EN1^DIP

 +4        QUIT

 +5       ;

PRT4      ;Report 4

 +1        NEW XD0

 +2        SET FLDS="[ONCO XINCIDENCE RPRT]"

           SET (FR,TO)=NUMBER

           SET BY="@NUMBER"

           SET DIC="^ONCO(165.5,"

           SET L=0

           DO EN1^DIP

 +3        QUIT

 +4       ;

 +5       ;QA FORM

8          SET DIWF=$SELECT($GET(ESPD)=1:"^ONCO(160.2,9,1,",1:"^ONCO(160.2,8,1,")

 +1        SET DIWF(1)="165.5"

           SET BY="NUMBER"

           SET (FR,TO)=ONCODA

           SET TMPIO=IO

           WRITE !!

           DO EN2^DIWF

           SET IOP=ONCOION

           DO ^%ZIS

 +2        QUIT

 +3       ;

CK        ;Check entry TO PREVENT DELETION

 +1       ;    package developer can kill

           IF DUZ=231

               IF DUZ(2)=10688

                   QUIT

 +2        IF DA>3

               KILL ^ONCO(160.2,"B",$EXTRACT(X,1,30),DA)

               QUIT

 +3       ;TO prevent deletion of exported entries.

           WRITE !!?5,"CANNOT DELETE THIS ENTRY"

H         ;HALT

           GOTO ^XUSCLEAN

 +1        QUIT

EX        ;EXIT

 +1        KILL DIC,DIR,ONCOXD0,ONCOXD1,ONCOS,DIOEND,FR,TO,BY,L,^TMP("ONCO",$JOB)

 +2        DO ^%ZISC

 +3        QUIT

ONCOPMP.m