MCARGP.m

MCARGP ;WISC/TJK-ENDOSCOPY REPORTS ;12/15/97  14:49

 ;;2.3;Medicine;**15**;09/13/1996

ENDO ; Endoscopic Report

 I +$G(MCARGDA)>0 G EN1

 D MCPPROC^MCARP

 S MCARGNON=$O(^MCAR(697.2,"B","NON-ENDO",0)),MCARGCON=$O(^MCAR(697.2,"B","CONSULT",0)),DIC("S")="I ($P(^(0),U,12)'=MCARGCON),($P(^(0),U,12)'=MCARGNON),($D(^MCAR(697.2,""D"",MCARCODE,$P(^MCAR(699,+Y,0),U,12))))"

 S MCARGRTN=$S($G(MCARCODE)="G"&($G(MCBP)=1):"GIB",$G(MCBP)=1:"PULMB",$G(MCARCODE)="G":"GI",1:"PULM"),DIC("A")="Select Patient or Date/Time of Endoscopic Procedure: " G LOOK

NONENDO ; Non Endoscopic Report

 D MCPPROC^MCARP

 S MCARGNUM=$O(^MCAR(697.2,"B","NON-ENDO",0)),DIC("S")="I $P(^MCAR(699,+Y,0),U,12)=MCARGNUM",MCARGRTN=$S($G(MCBP)=1:"NONENDOB",1:"NONENDO"),DIC("A")="Select Patient or Date/Time of Non-Endoscopic Procedure: " G LOOK

CONSULT ; Office Consult Report

 S DIC="^MCAR(699.5,",MCESON=0

 S MCARGNUM=$O(^MCAR(697.2,"B","CONSULT",0)),DIC("S")="I $P(^MCAR(699.5,+Y,0),U,3)",MCARGRTN=$S($G(MCBP)=1:"CONSULTB",1:"CONSULT"),DIC("A")="Select Patient or Date/Time of Consultation: " G LOOK1

LOOK S DIC="^MCAR(699,",MCFILE=699,MCON=1

LOOK1 I MCESON S DIC("S")=$$PREVIEW^MCESSCR(MCFILE)

 S DIC(0)="AEMQZ" D ^DIC K DIC,MCARGCON,MCARGNON,MCARGNUM G EXIT:Y<0

 S MCARGDA=+Y

EN1 ;ENTRY POINT FROM SUMMARY OF PATIENT PROCEDURES ROUTINE

 S MCARZ=$S(MCARGRTN?1"N".E:"NON-ENDOSCOPIC",MCARGRTN?1"C".E:"CONSULT",1:"ENDOSCOPIC")_" REPORT"

 D:$G(MCESON) STATUS^MCESPRT(MCFILE,MCARGDA)

 I $D(ORHFS) U IO G PRINT ;dcm/slc added for CPRS

DEVQUE ; Device Control and Queuing Control

 K IO("Q") S %ZIS="MQ" D ^%ZIS I POP S MCOUT="" G EXIT

 I $D(IO("Q")) S ZTSAVE("MC*")="",ZTRTN="PRINT^MCARGP",ZTDESC=MCARZ D ^%ZTLOAD K ZTSK G EXIT

 U IO

PRINT ; Print Report

 S DIC=$S(MCARGRTN["CONSULT":"^MCAR(699.5,",1:"^MCAR(699,"),MCFILE=699 G PRINT^MCARP

EXIT ;

 I '$D(MCOUT),IOST'?1"P-".E R !!,"* END * Press return to continue: ",X:DTIME

 K ^UTILITY($J),IO("Q"),MCARGDA,MCARGDT,SSN,MCARPPS,MCOUT

 K MCARGNM,MCARGRTN,X,DFN,SSN,MCARGNUM,MCARGNAM,MCARZ,DN,D0,FLDS,MCARCODE

 K DIOEND,DIOBEG,DI,DICS,DJ,BY,A,DICSS,MCON,MCARGDA

 K DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC

 K DL,DV,DE,DA,DK,Y,R,C,D,I,J,Q,M,P,N,D1,DIW,DIWL,DIWR,DIWT,PG,Z,L,DIPGM,DICMX,DIXX,VA,%Y1,%Y2,DIJ,DP,B

 K MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS,MCSUP

 K MCARDE,MCESS,MCESSEC,MCFILE1,MCOUNT,MCPATFLD,MCPOSTP,MCPRO

 W:IOST?1"P-".E @IOF D ^%ZISC Q

RECALL K DIC,FR,TO,DIS S MCPRO="LAP" D MCPPROC^MCARP

 S DIC="^MCAR(699,",BY="[MCARGIRCLI]",L=0

 S FLDS="[MCARGIRCLI]"

 S DIS(0)="I $D(^MCAR(697.2,""D"",MCARCODE,$P(^MCAR(699,D0,0),U,12)))"

 S DIS(1)="I $D(^MCAR(699,D0,25,""B"",2))"

 S:$G(MCESON)=1 DIS(2)="I $$SCRGI^MCESSCR(699,D0,MCESKEY,MCSUP)"

 D EN1^DIP K DIS

 G EXIT

MCARGP    ;WISC/TJK-ENDOSCOPY REPORTS ;12/15/97  14:49

 +1       ;;2.3;Medicine;**15**;09/13/1996

ENDO      ; Endoscopic Report

 +1        IF +$GET(MCARGDA)>0

               GOTO EN1

 +2        DO MCPPROC^MCARP

 +3        SET MCARGNON=$ORDER(^MCAR(697.2,"B","NON-ENDO",0))

           SET MCARGCON=$ORDER(^MCAR(697.2,"B","CONSULT",0))

           SET DIC("S")="I ($P(^(0),U,12)'=MCARGCON),($P(^(0),U,12)'=MCARGNON),($D(^MCAR(697.2,""D"",MCARCODE,$P(^MCAR(699,+Y,0),U,12))))"

 +4        SET MCARGRTN=$SELECT($GET(MCARCODE)="G"&($GET(MCBP)=1):"GIB",$GET(MCBP)=1:"PULMB",$GET(MCARCODE)="G":"GI",1:"PULM")

           SET DIC("A")="Select Patient or Date/Time of Endoscopic Procedure: "

           GOTO LOOK

NONENDO   ; Non Endoscopic Report

 +1        DO MCPPROC^MCARP

 +2        SET MCARGNUM=$ORDER(^MCAR(697.2,"B","NON-ENDO",0))

           SET DIC("S")="I $P(^MCAR(699,+Y,0),U,12)=MCARGNUM"

           SET MCARGRTN=$SELECT($GET(MCBP)=1:"NONENDOB",1:"NONENDO")

           SET DIC("A")="Select Patient or Date/Time of Non-Endoscopic Procedure: "

           GOTO LOOK

CONSULT   ; Office Consult Report

 +1        SET DIC="^MCAR(699.5,"

           SET MCESON=0

 +2        SET MCARGNUM=$ORDER(^MCAR(697.2,"B","CONSULT",0))

           SET DIC("S")="I $P(^MCAR(699.5,+Y,0),U,3)"

           SET MCARGRTN=$SELECT($GET(MCBP)=1:"CONSULTB",1:"CONSULT")

           SET DIC("A")="Select Patient or Date/Time of Consultation: "

           GOTO LOOK1

LOOK       SET DIC="^MCAR(699,"

           SET MCFILE=699

           SET MCON=1

LOOK1      IF MCESON

               SET DIC("S")=$$PREVIEW^MCESSCR(MCFILE)

 +1        SET DIC(0)="AEMQZ"

           DO ^DIC

           KILL DIC,MCARGCON,MCARGNON,MCARGNUM

           IF Y<0

               GOTO EXIT

 +2        SET MCARGDA=+Y

EN1       ;ENTRY POINT FROM SUMMARY OF PATIENT PROCEDURES ROUTINE

 +1        SET MCARZ=$SELECT(MCARGRTN?1"N".E:"NON-ENDOSCOPIC",MCARGRTN?1"C".E:"CONSULT",1:"ENDOSCOPIC")_" REPORT"

 +2        IF $GET(MCESON)

               DO STATUS^MCESPRT(MCFILE,MCARGDA)

 +3       ;dcm/slc added for CPRS

           IF $DATA(ORHFS)

               USE IO

               GOTO PRINT

DEVQUE    ; Device Control and Queuing Control

 +1        KILL IO("Q")

           SET %ZIS="MQ"

           DO ^%ZIS

           IF POP

               SET MCOUT=""

               GOTO EXIT

 +2        IF $DATA(IO("Q"))

               SET ZTSAVE("MC*")=""

               SET ZTRTN="PRINT^MCARGP"

               SET ZTDESC=MCARZ

               DO ^%ZTLOAD

               KILL ZTSK

               GOTO EXIT

 +3        USE IO

PRINT     ; Print Report

 +1        SET DIC=$SELECT(MCARGRTN["CONSULT":"^MCAR(699.5,",1:"^MCAR(699,")

           SET MCFILE=699

           GOTO PRINT^MCARP

EXIT      ;

 +1        IF '$DATA(MCOUT)

               IF IOST'?1"P-".E

 +3        KILL MCARGNM,MCARGRTN,X,DFN,SSN,MCARGNUM,MCARGNAM,MCARZ,DN,D0,FLDS,MCARCODE

 +4        KILL DIOEND,DIOBEG,DI,DICS,DJ,BY,A,DICSS,MCON,MCARGDA

 +5        KILL DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC

 +6        KILL DL,DV,DE,DA,DK,Y,R,C,D,I,J,Q,M,P,N,D1,DIW,DIWL,DIWR,DIWT,PG,Z,L,DIPGM,DICMX,DIXX,VA,%Y1,%Y2,DIJ,DP,B

 +7        KILL MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS,MCSUP

 +8        KILL MCARDE,MCESS,MCESSEC,MCFILE1,MCOUNT,MCPATFLD,MCPOSTP,MCPRO

 +9        IF IOST?1"P-".E

               WRITE @IOF

           DO ^%ZISC

           QUIT 

RECALL     KILL DIC,FR,TO,DIS

           SET MCPRO="LAP"

           DO MCPPROC^MCARP

 +1        SET DIC="^MCAR(699,"

           SET BY="[MCARGIRCLI]"

           SET L=0

 +2        SET FLDS="[MCARGIRCLI]"

 +3        SET DIS(0)="I $D(^MCAR(697.2,""D"",MCARCODE,$P(^MCAR(699,D0,0),U,12)))"

 +4        SET DIS(1)="I $D(^MCAR(699,D0,25,""B"",2))"

 +5        IF $GET(MCESON)=1

               SET DIS(2)="I $$SCRGI^MCESSCR(699,D0,MCESKEY,MCSUP)"

 +6        DO EN1^DIP

           KILL DIS

 +7        GOTO EXIT