- GMRCYP31 ;SLC/JFR - POST-INIT FOR PATCH 31; 2/04/03 08:02
- ;;3.0;CONSULT/REQUEST TRACKING;**31,32**;DEC 27, 1997
- ;
- ; Re-distributed with GMRC*3*32 to address error with no records
- ; to print when sent to a printer.
- Q
- POST ;
- N %ZIS,GMRCQT,POP
- W !!,"This report should be sent to a printer",!
- S %ZIS="" D ^%ZIS
- I POP Q
- I $D(IO("Q")) D Q
- . N ZTRTN,ZTDTH,ZTIO,ZTSAVE,ZTDESC
- . S ZTRTN="POST1^GMRCYP31",ZTIO=ION,ZTDTH=$H
- . S ZTDESC="GMRC*3*31 Post-Install Report"
- . D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q
- . W !,"REPORT TASKED TO PRINT!"
- . Q
- D POST1
- Q
- POST1 ; START POST-INIT
- N GMRCO,GMRCISIT,GMRCRO
- S GMRCISIT=0
- F S GMRCISIT=$O(^GMR(123,"AIFC",GMRCISIT)) Q:'GMRCISIT D
- . S GMRCRO=0
- . F S GMRCRO=$O(^GMR(123,"AIFC",GMRCISIT,GMRCRO)) Q:'GMRCRO D
- .. S GMRCO=$O(^GMR(123,"AIFC",GMRCISIT,GMRCRO,0))
- .. I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
- ... D ACTS(GMRCO)
- ... I $D(^TMP("GMRCYP31",$J,GMRCISIT,GMRCO)) D
- .... S ^TMP("GMRCYP31",$J,GMRCISIT,GMRCO)=""
- .. Q
- . Q
- D PRINT
- Q
- ;
- ACTS(CSLT) ;loop activities and see if there is a remote FWD or SF update
- ;CSTL = ien from file 123
- N ACTV
- S ACTV=0
- F S ACTV=$O(^GMR(123,CSLT,40,ACTV)) Q:'ACTV D
- . N ACTYPE
- . S ACTYPE=$P(^GMR(123,CSLT,40,ACTV,0),U,2)
- . Q:ACTYPE'=17&(ACTYPE'=4) ;only FWD and SF are affected
- . Q:'$D(^GMR(123,CSLT,40,ACTV,2)) ;only remote activities
- . Q:'$O(^GMR(123,CSLT,40,ACTV,1,1)) ;only comments >1 line long
- . N SITE
- . S SITE=$P(^GMR(123,CSLT,0),U,23)
- . S ^TMP("GMRCYP31",$J,SITE,CSLT,ACTV,0)=""
- Q
- ;
- PRINT ; loop the ^TMP global and write records
- ; ask device and queue if needed
- ;
- ;I $D(ZTQUEUED) S ZTREQ="@"
- N GMRCCT,TAB,GMRCDA,GMRCSIT,ACT,REMNUM,GMRCPG
- U IO
- S GMRCPG=1
- D HDR(.GMRCPG)
- I '$O(^TMP("GMRCYP31",$J,0)) D D ^%ZISC,HOME^%ZIS Q
- . W !,"No records to report"
- . I $E(IOST,1,2)="C-" N DIR S DIR(0)="E" D ^DIR
- . Q
- S TAB=$$REPEAT^XLFSTR(" ",29)
- W !,"No cleanup or modification should be made to Inter-facility consults that are "
- W !,"identified with extraneous comments at this time. Patch GMRC*3*32 will outline"
- W !,"the processes that should be utilized to properly accomplish these corrections."
- W !,$$REPEAT^XLFSTR("*",79)
- W !!
- S GMRCSIT=0
- F S GMRCSIT=$O(^TMP("GMRCYP31",$J,GMRCSIT)) Q:'GMRCSIT D
- . S GMRCDA=0
- . F S GMRCDA=$O(^TMP("GMRCYP31",$J,GMRCSIT,GMRCDA)) Q:'GMRCDA D
- .. I (IOSL-$Y)<7 D HDR(.GMRCPG) I 'GMRCPG S GMRCDA=999999999 Q
- .. N PTNM,PTSSN,REMSIT
- .. S PTNM="Patient name: "_$$GET1^DIQ(123,GMRCDA,.02,"E")
- .. S PTSSN="SSN: "_$$GET1^DIQ(2,$P(^GMR(123,GMRCDA,0),U,2),.09)
- .. S REMSIT=$$GET1^DIQ(4,$P(^GMR(123,GMRCDA,0),U,23),.01)
- .. S REMNUM=$P(^GMR(123,GMRCDA,0),U,22)
- .. I GMRCPG>2 W !,$$REPEAT^XLFSTR("*",78)
- .. W !,"Consult #: ",GMRCDA
- .. W !,PTNM,?50,PTSSN
- .. W !,"Receiving Site: ",REMSIT,?50,"Remote Consult #: ",REMNUM
- .. W !!,$$CJ^XLFSTR("Activities for Review",78)
- .. W !,$$CJ^XLFSTR("*********************",78)
- .. I (IOSL-$Y)<4 D HDR(.GMRCPG) I 'GMRCPG S GMRCDA=999999999 Q
- .. W !,"Facility"
- .. W !," Activity",?25,"Date/Time/Zone",$E(TAB,1,6)
- .. W "Responsible Person",$E(TAB,1,2),"Entered By"
- .. W !,$$REPEAT^XLFSTR("-",79)
- .. S ACT=0
- .. F S ACT=$O(^TMP("GMRCYP31",$J,GMRCSIT,GMRCDA,ACT)) Q:'ACT D
- ... N GMRCCT S GMRCCT=1
- ... I (IOSL-$Y)<6 D HDR(.GMRCPG,GMRCDA) I 'GMRCPG D Q
- .... S (ACT,GMRCDA)=9999999999
- ... W !,?11,"Act. #:",ACT
- ... D BLDALN^GMRCSLM4(GMRCDA,ACT)
- ... N I S I=0
- ... F S I=$O(^TMP("GMRCR",$J,"DT",I)) Q:'I D
- .... I (IOSL-$Y)<5 D HDR(.GMRCPG,GMRCDA) I 'GMRCPG D Q
- ..... S (I,ACT,GMRCDA)=9999999999
- .... W !,$G(^TMP("GMRCR",$J,"DT",I,0))
- ... K ^TMP("GMRCR",$J,"DT")
- .. W !
- .. Q
- . Q
- D ^%ZISC,HOME^%ZIS
- D EXIT
- Q
- ;
- HDR(PAGE,CSLT) ;print a new header
- ; PAGE = next page number
- ; CSLT = consult ien working on
- ;
- I $E(IOST,1,2)="C-",PAGE>1 D I 'PAGE Q
- . N DIR,DIROUT,DIRUT,DTOUT,DUOUT
- . S DIR(0)="E" D ^DIR
- . I $D(DIRUT) S PAGE=0
- W @IOF
- W !,"GMRC*3*31 Post-Install",?69,"Page: ",PAGE
- W !,$$REPEAT^XLFSTR("-",79)
- I $D(CSLT) D
- . N TEXT
- . S TEXT="Consult # "_CSLT_" cont'd."
- . W !,$$CJ^XLFSTR(TEXT,80)
- . W !
- S PAGE=PAGE+1
- Q
- EXIT ; clean up
- K ^TMP("GMRCYP31",$J)
- Q
- GMRCYP31 ;SLC/JFR - POST-INIT FOR PATCH 31; 2/04/03 08:02
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**31,32**;DEC 27, 1997
- +2 ;
- +3 ; Re-distributed with GMRC*3*32 to address error with no records
- +4 ; to print when sent to a printer.
- +5 QUIT
- POST ;
- +1 NEW %ZIS,GMRCQT,POP
- +2 WRITE !!,"This report should be sent to a printer",!
- +3 SET %ZIS=""
- DO ^%ZIS
- +4 IF POP
- QUIT
- +5 IF $DATA(IO("Q"))
- Begin DoDot:1
- +6 NEW ZTRTN,ZTDTH,ZTIO,ZTSAVE,ZTDESC
- +7 SET ZTRTN="POST1^GMRCYP31"
- SET ZTIO=ION
- SET ZTDTH=$HOROLOG
- +8 SET ZTDESC="GMRC*3*31 Post-Install Report"
- +9 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL IO("Q")
- QUIT
- +10 WRITE !,"REPORT TASKED TO PRINT!"
- +11 QUIT
- End DoDot:1
- QUIT
- +12 DO POST1
- +13 QUIT
- POST1 ; START POST-INIT
- +1 NEW GMRCO,GMRCISIT,GMRCRO
- +2 SET GMRCISIT=0
- +3 FOR
- SET GMRCISIT=$ORDER(^GMR(123,"AIFC",GMRCISIT))
- IF 'GMRCISIT
- QUIT
- Begin DoDot:1
- +4 SET GMRCRO=0
- +5 FOR
- SET GMRCRO=$ORDER(^GMR(123,"AIFC",GMRCISIT,GMRCRO))
- IF 'GMRCRO
- QUIT
- Begin DoDot:2
- +6 SET GMRCO=$ORDER(^GMR(123,"AIFC",GMRCISIT,GMRCRO,0))
- +7 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
- Begin DoDot:3
- +8 DO ACTS(GMRCO)
- +9 IF $DATA(^TMP("GMRCYP31",$JOB,GMRCISIT,GMRCO))
- Begin DoDot:4
- +10 SET ^TMP("GMRCYP31",$JOB,GMRCISIT,GMRCO)=""
- End DoDot:4
- End DoDot:3
- +11 QUIT
- End DoDot:2
- +12 QUIT
- End DoDot:1
- +13 DO PRINT
- +14 QUIT
- +15 ;
- ACTS(CSLT) ;loop activities and see if there is a remote FWD or SF update
- +1 ;CSTL = ien from file 123
- +2 NEW ACTV
- +3 SET ACTV=0
- +4 FOR
- SET ACTV=$ORDER(^GMR(123,CSLT,40,ACTV))
- IF 'ACTV
- QUIT
- Begin DoDot:1
- +5 NEW ACTYPE
- +6 SET ACTYPE=$PIECE(^GMR(123,CSLT,40,ACTV,0),U,2)
- +7 ;only FWD and SF are affected
- IF ACTYPE'=17&(ACTYPE'=4)
- QUIT
- +8 ;only remote activities
- IF '$DATA(^GMR(123,CSLT,40,ACTV,2))
- QUIT
- +9 ;only comments >1 line long
- IF '$ORDER(^GMR(123,CSLT,40,ACTV,1,1))
- QUIT
- +10 NEW SITE
- +11 SET SITE=$PIECE(^GMR(123,CSLT,0),U,23)
- +12 SET ^TMP("GMRCYP31",$JOB,SITE,CSLT,ACTV,0)=""
- End DoDot:1
- +13 QUIT
- +14 ;
- PRINT ; loop the ^TMP global and write records
- +1 ; ask device and queue if needed
- +2 ;
- +3 ;I $D(ZTQUEUED) S ZTREQ="@"
- +4 NEW GMRCCT,TAB,GMRCDA,GMRCSIT,ACT,REMNUM,GMRCPG
- +5 USE IO
- +6 SET GMRCPG=1
- +7 DO HDR(.GMRCPG)
- +8 IF '$ORDER(^TMP("GMRCYP31",$JOB,0))
- Begin DoDot:1
- +9 WRITE !,"No records to report"
- +10 IF $EXTRACT(IOST,1,2)="C-"
- NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +11 QUIT
- End DoDot:1
- DO ^%ZISC
- DO HOME^%ZIS
- QUIT
- +12 SET TAB=$$REPEAT^XLFSTR(" ",29)
- +13 WRITE !,"No cleanup or modification should be made to Inter-facility consults that are "
- +14 WRITE !,"identified with extraneous comments at this time. Patch GMRC*3*32 will outline"
- +15 WRITE !,"the processes that should be utilized to properly accomplish these corrections."
- +16 WRITE !,$$REPEAT^XLFSTR("*",79)
- +17 WRITE !!
- +18 SET GMRCSIT=0
- +19 FOR
- SET GMRCSIT=$ORDER(^TMP("GMRCYP31",$JOB,GMRCSIT))
- IF 'GMRCSIT
- QUIT
- Begin DoDot:1
- +20 SET GMRCDA=0
- +21 FOR
- SET GMRCDA=$ORDER(^TMP("GMRCYP31",$JOB,GMRCSIT,GMRCDA))
- IF 'GMRCDA
- QUIT
- Begin DoDot:2
- +22 IF (IOSL-$Y)<7
- DO HDR(.GMRCPG)
- IF 'GMRCPG
- SET GMRCDA=999999999
- QUIT
- +23 NEW PTNM,PTSSN,REMSIT
- +24 SET PTNM="Patient name: "_$$GET1^DIQ(123,GMRCDA,.02,"E")
- +25 SET PTSSN="SSN: "_$$GET1^DIQ(2,$PIECE(^GMR(123,GMRCDA,0),U,2),.09)
- +26 SET REMSIT=$$GET1^DIQ(4,$PIECE(^GMR(123,GMRCDA,0),U,23),.01)
- +27 SET REMNUM=$PIECE(^GMR(123,GMRCDA,0),U,22)
- +28 IF GMRCPG>2
- WRITE !,$$REPEAT^XLFSTR("*",78)
- +29 WRITE !,"Consult #: ",GMRCDA
- +30 WRITE !,PTNM,?50,PTSSN
- +31 WRITE !,"Receiving Site: ",REMSIT,?50,"Remote Consult #: ",REMNUM
- +32 WRITE !!,$$CJ^XLFSTR("Activities for Review",78)
- +33 WRITE !,$$CJ^XLFSTR("*********************",78)
- +34 IF (IOSL-$Y)<4
- DO HDR(.GMRCPG)
- IF 'GMRCPG
- SET GMRCDA=999999999
- QUIT
- +35 WRITE !,"Facility"
- +36 WRITE !," Activity",?25,"Date/Time/Zone",$EXTRACT(TAB,1,6)
- +37 WRITE "Responsible Person",$EXTRACT(TAB,1,2),"Entered By"
- +38 WRITE !,$$REPEAT^XLFSTR("-",79)
- +39 SET ACT=0
- +40 FOR
- SET ACT=$ORDER(^TMP("GMRCYP31",$JOB,GMRCSIT,GMRCDA,ACT))
- IF 'ACT
- QUIT
- Begin DoDot:3
- +41 NEW GMRCCT
- SET GMRCCT=1
- +42 IF (IOSL-$Y)<6
- DO HDR(.GMRCPG,GMRCDA)
- IF 'GMRCPG
- Begin DoDot:4
- +43 SET (ACT,GMRCDA)=9999999999
- End DoDot:4
- QUIT
- +44 WRITE !,?11,"Act. #:",ACT
- +45 DO BLDALN^GMRCSLM4(GMRCDA,ACT)
- +46 NEW I
- SET I=0
- +47 FOR
- SET I=$ORDER(^TMP("GMRCR",$JOB,"DT",I))
- IF 'I
- QUIT
- Begin DoDot:4
- +48 IF (IOSL-$Y)<5
- DO HDR(.GMRCPG,GMRCDA)
- IF 'GMRCPG
- Begin DoDot:5
- +49 SET (I,ACT,GMRCDA)=9999999999
- End DoDot:5
- QUIT
- +50 WRITE !,$GET(^TMP("GMRCR",$JOB,"DT",I,0))
- End DoDot:4
- +51 KILL ^TMP("GMRCR",$JOB,"DT")
- End DoDot:3
- +52 WRITE !
- +53 QUIT
- End DoDot:2
- +54 QUIT
- End DoDot:1
- +55 DO ^%ZISC
- DO HOME^%ZIS
- +56 DO EXIT
- +57 QUIT
- +58 ;
- HDR(PAGE,CSLT) ;print a new header
- +1 ; PAGE = next page number
- +2 ; CSLT = consult ien working on
- +3 ;
- +4 IF $EXTRACT(IOST,1,2)="C-"
- IF PAGE>1
- Begin DoDot:1
- +5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
- +6 SET DIR(0)="E"
- DO ^DIR
- +7 IF $DATA(DIRUT)
- SET PAGE=0
- End DoDot:1
- IF 'PAGE
- QUIT
- +8 WRITE @IOF
- +9 WRITE !,"GMRC*3*31 Post-Install",?69,"Page: ",PAGE
- +10 WRITE !,$$REPEAT^XLFSTR("-",79)
- +11 IF $DATA(CSLT)
- Begin DoDot:1
- +12 NEW TEXT
- +13 SET TEXT="Consult # "_CSLT_" cont'd."
- +14 WRITE !,$$CJ^XLFSTR(TEXT,80)
- +15 WRITE !
- End DoDot:1
- +16 SET PAGE=PAGE+1
- +17 QUIT
- EXIT ; clean up
- +1 KILL ^TMP("GMRCYP31",$JOB)
- +2 QUIT