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

GMRCYP31.m

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