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

GMPLNTRT.m

Go to the documentation of this file. 
  1. GMPLNTRT ;ISL/JER - Problem List NTRT Mapping Follow-up Report ; 6/19/18 12:53pm
  1.  ;;2.0;Problem List;**36,52**;Aug 25, 1994;Build 5
  1.  ;
  1.  ; ICR #664      - DIVISION^VAUTOMA
  1.  ;     #2055     - $$EXTERNAL^DILFD
  1.  ;     #2056     - $$GET1^DIQ
  1.  ;     #3444     - ^DG(43,1
  1.  ;     #3799     - $$FMTE^XLFDT
  1.  ;     #4558     - $$LEAP^XLFDT3
  1.  ;     #4631     - $$NOW^XLFDT
  1.  ;     #10000    - %, %I, %T, %Y Local vars
  1.  ;     #10063    - ^%ZTLOAD
  1.  ;     #10086    - ^%ZIS Routine & IO, IOF, ION, IOSL, & IOST Local Vars
  1.  ;     #10089    - ^%ZISC Routine & IO("Q") Local Var
  1.  ;     #10104    - $$LOW^XLFSTR, $$UP^XLFSTR
  1.  ;     #10112    - $$NAME^VASITE, $$SITE^VASITE
  1.  ;     #10114    - %ZIS Local Var
  1.  ;
  1. MAIN ; Main subroutine
  1.  N DIC,DIRUT,BADDIV,SELDIV,GMPLEDT,GMPLLDT,GMPLNTST,GMPLDI,VAUTD,ZTRTN,%I,%T,%Y,POP,GMPL1PR,GMPLPR,GMPLPCOM
  1.  S GMPLPR=0
  1.  W !!,$$CENTER^GMPLUTL1("--- Problem List NTRT Mapping Follow-up Report ---"),!
  1.  D SELDIV(.GMPLDI) Q:'$D(GMPLDI)!$D(DIRUT)
  1.  W !
  1.  S GMPLNTST=$P($$READ^GMPLUTL1("SA^0:All;1:Pending;2:Completed","NTRT Status? ","ALL","Indicate the NTRT Status for the report."),U)
  1.  I $D(DIRUT) Q
  1.  W !
  1.  S GMPL1PR=$$READ^GMPLUTL1("YA","Specific Provider(s)? ","NO","Indicate whether you would like to run the report for one or more specific Providers.")
  1.  I $D(DIRUT) Q
  1.  I +GMPL1PR D PROVSEL(.GMPLPR) Q:'+$G(GMPLPR)!+$G(DIROUT)
  1.  W !
  1.  S GMPLEDT=+$$EDATE^GMPLUTL1("Modification","","T-30")
  1.  W !
  1.  I GMPLEDT'>0 Q
  1.  S GMPLLDT=+$$LDATE^GMPLUTL1("Modification","","NOW")
  1.  W !
  1.  I GMPLLDT'>0 Q
  1.  S ZTRTN="ENTRY^GMPLNTRT"
  1. DEVICE ; Device handling
  1.  ; Call with: ZTRTN
  1.  N %ZIS
  1.  S %ZIS="Q" D ^%ZIS Q:POP
  1.  G:$D(IO("Q")) QUE
  1. NOQUE ; Call report directly
  1.  D @ZTRTN
  1.  Q
  1. QUE ; Queue output
  1.  N %,ZTDTH,ZTIO,ZTSAVE,ZTSK
  1.  Q:'$D(ZTRTN)
  1.  K IO("Q") F %="DA","DFN","GMPL*" S ZTSAVE(%)=""
  1.  S:'$D(ZTDESC) ZTDESC="PRINT NTRT FOLLOW-UP REPORT" S ZTIO=ION
  1.  D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
  1.  K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  D HOME^%ZIS
  1.  Q
  1. PROVSEL(GMPLY) ; Select Providers
  1.  N DIRUT,GMPLQUIT,GMPLPRSN,GMPLI,GMPLPRMT,GMPLVBCUC,GMPLSCRN,GMPLHLP S (GMPLY,GMPLI,GMPLQUIT)=0
  1.  ; Identify User Class for VBC Line Count
  1.  S GMPLHLP="Please choose a KNOWN Provider (Duplicates not allowed)."
  1.  S GMPLSCRN="I '$D(GMPLY(""I"",+Y)),$$CLINUSER^ORQQPL1(+Y)"
  1.  W !!,"Select Provider(s):",!
  1.  F  D  Q:+GMPLQUIT
  1.  . S GMPLI=GMPLI+1,GMPLPRMT=$J(GMPLI,3)_")  "
  1.  . S GMPLPRSN=$$READ^GMPLUTL1("PAO^200:AEMQ",GMPLPRMT,"",GMPLHLP,GMPLSCRN)
  1.  . I +GMPLPRSN'>0 S GMPLQUIT=1 Q
  1.  . S GMPLY=GMPLI,GMPLY(GMPLI)=GMPLPRSN,GMPLY("I",+GMPLPRSN)=GMPLI
  1.  W !
  1.  Q
  1. SELDIV(GMPLDI) ; Select divisions
  1.  ;
  1.  ; Output - SELDIV  -1= user ^ at prompt if multidivisional
  1.  ;                   0= institution file pointer missing for
  1.  ;                      division entry
  1.  ;                   1= successful division selection
  1.  ;          BADDIV    = comma-delimited list of bad divisions (if any)
  1.  ;          GMPLDI(  undefined= user <cr> for all divisions or ^ at prompt
  1.  ;                             if multidivisional
  1.  ;                  defined= user selected one or more divisions if
  1.  ;                           multidivisional, or pre-selection of
  1.  ;                           division file entry if not multidivisional;
  1.  ;                           i.e.: GMPLDI(file #40.8 ien)= Institution
  1.  ;                           file pointer for file #40.8 entry
  1.  N DIRUT,DTOUT,DUOUT,GMPLI,VAUTD,Y
  1.  K SELDIV,GMPLDI,BADDIV
  1.  ; -- Determine if facility is multidivisional
  1.  I $P($G(^DG(43,1,"GL")),U,2) D
  1.  . D DIVISION^VAUTOMA
  1.  . I Y<0 S SELDIV=-1 Q
  1.  . I VAUTD=1 S SELDIV=1 Q
  1.  . S GMPLI=0 F  S GMPLI=$O(VAUTD(GMPLI)) Q:'GMPLI  D ONE(GMPLI,.VAUTD,.GMPLDI)
  1.  E  S GMPLI=$$PRIM^VASITE D ONE(GMPLI,.VAUTD)
  1.  Q:SELDIV=-1
  1.  I +SELDIV=0 D  Q:'$D(GMPLDI)
  1.  . W !!,"Inconsistencies found between the MEDICAL CENTER DIVISION FILE, the INSTITUTION"
  1.  . W !,"FILE and/or STATION NUMBER (TIME SENSITIVE) FILE for the:",!!,$S($G(BADDIV)]"":BADDIV_" division"_$S($L(BADDIV,",")>1:"s",1:""),1:"a division you selected"),"."
  1.  . W !!,"Please contact the National Support team."
  1.  . I '$D(GMPLDI) W ! S:'$$READ^GMPLUTL1("E") DIRUT=1
  1.  I $D(GMPLDI) D
  1.  . N GMPLK
  1.  . S GMPLK=0 F  S GMPLK=$O(GMPLDI(GMPLK)) Q:'GMPLK  D
  1.  . . S GMPLDI("INST",GMPLDI(GMPLK))=GMPLK
  1.  . . S GMPLDI("ENTRIES")=$G(GMPLDI("ENTRIES"))_GMPLK_";"
  1.  E  S GMPLDI("ENTRIES")="ALL DIVISIONS"
  1.  Q
  1.  ;
  1. ONE(GMPLI,VAUTD,GMPLDI) ; Input - GMPLI  Medical Center Division file (#40.8) IEN
  1.  N GMPLIFP
  1.  S GMPLIFP=$P($$SITE^VASITE(,GMPLI),U) I GMPLIFP>0 D
  1.  . S GMPLDI(GMPLI)=GMPLIFP,SELDIV=1
  1.  E  D
  1.  . S SELDIV=0,BADDIV=$G(BADDIV)_$S($L($G(BADDIV)):", ",1:"")_$G(VAUTD(GMPLI))
  1.  Q
  1.  ;
  1. ENTRY ; Build & Print Report
  1.  N GMPLA
  1.  S GMPLA=$NA(^TMP("GMPLNTRT",$J))
  1.  U IO
  1.  D GATHER(.GMPLDI,GMPLA,GMPLEDT,GMPLLDT,GMPLNTST,.GMPLPR)
  1.  D REPORT(GMPLA,GMPLEDT,GMPLLDT)
  1.  K @GMPLA
  1.  D ^%ZISC
  1.  Q
  1. GATHER(GMPLDI,GMPLA,GMPLEDT,GMPLLDT,GMPLNTST,GMPLPR) ; Gather records that satisfy criteria
  1.  N GMPLDA,GMPLDT,GMPLNOS,GMPLPOP,GMPLST0,GMPLST1  K @GMPLA
  1.  S GMPLNOS=+$$NOS^GMPLX,GMPLDA="",GMPLPOP=0
  1.  S GMPLST0=$S(GMPLNTST=0:1,1:GMPLNTST),GMPLST1=$S(GMPLNTST=0:2,1:GMPLNTST)
  1.  ; Insure inclusive early date/time by subtracting one minute before $ORDER
  1.  S GMPLDT=$$FMADD^XLFDT(GMPLEDT,0,0,-1)
  1.  ; Insure inclusive end date/time by appending time of 23:59 if time not indicated
  1.  I $L(GMPLLDT,".")=1 S $P(GMPLLDT,".",2)="2359"
  1.  F  S GMPLDT=$O(^AUPNPROB("DM",GMPLDT)) Q:(+GMPLDT>GMPLLDT)!(+GMPLDT'>0)  D  Q:+GMPLPOP
  1.  . N GMPLSTI F GMPLSTI=GMPLST0:1:GMPLST1 D  Q:+GMPLPOP
  1.  . . N GMPLDA S GMPLDA=0
  1.  . . F  S GMPLDA=$O(^AUPNPROB("DM",GMPLDT,GMPLSTI,GMPLDA)) Q:+GMPLDA'>0  D  Q:+GMPLPOP
  1.  . . . N GMPLD0,GMPLD1,GMPLD800,GMPLDIV,GMPLMDT,GMPLRPR,GMPLPTNM,GMPLPTL4,GMPLNARR
  1.  . . . N GMPLSVC,GMPLSVCA,GMPLSVCN,GMPLCL,GMPLCLA,GMPLCLN,GMPLSCTC,GMPLSTAT
  1.  . . . S GMPLD0=$G(^AUPNPROB(GMPLDA,0)),GMPLD1=$G(^(1)),GMPLD800=$G(^(800))
  1.  . . . S GMPLMDT=$P(GMPLD0,U,3)
  1.  . . . I GMPLMDT<GMPLEDT S GMPLPOP=1 Q
  1.  . . . I GMPLMDT>GMPLLDT Q
  1.  . . . S GMPLRPR=$P(GMPLD1,U,5),GMPLDIV=$P(GMPLD0,U,6),GMPLPTNM=$P(GMPLD0,U,2)
  1.  . . . I +$G(GMPLPR),'$D(GMPLPR("I",+GMPLRPR)) Q
  1.  . . . I $S(GMPLDI("ENTRIES")="ALL DIVISIONS":0,$D(GMPLDI("INST",+GMPLDIV)):0,1:1) Q
  1.  . . . S GMPLSVC=$P(GMPLD1,U,6),GMPLCL=$P(GMPLD1,U,8),GMPLSCTC=$P(GMPLD800,U)
  1.  . . . S GMPLSVCA=$S(GMPLSVC]"":$E($$GET1^DIQ(49,GMPLSVC,1),1,6),1:"n/a")
  1.  . . . S GMPLSVCN=$S(GMPLSVC]"":$E($$GET1^DIQ(49,GMPLSVC,.01),1,6),1:"n/a")
  1.  . . . S GMPLSVCA=$S(GMPLSVCA]"":GMPLSVCA,1:GMPLSVCN)
  1.  . . . S GMPLCLA=$S(GMPLCL]"":$E($$GET1^DIQ(44,GMPLCL,1),1,6),1:"n/a")
  1.  . . . S GMPLCLN=$S(GMPLCL]"":$E($$GET1^DIQ(44,GMPLCL,.01),1,6),1:"n/a")
  1.  . . . S GMPLCLA=$S(GMPLCLA]"":GMPLCLA,1:GMPLCLN)
  1.  . . . S GMPLDIV=$S(GMPLDIV]"":$$EXTERNAL^DILFD(9000011,.06,"",GMPLDIV),1:"DIVISION UNKNOWN")
  1.  . . . S GMPLRPR=$S(GMPLRPR=0:"n/a",GMPLRPR]"":$$EXTERNAL^DILFD(9000011,1.05,"",GMPLRPR),1:"n/a")
  1.  . . . S GMPLNARR=$$EXTERNAL^DILFD(9000011,.05,"",$P(GMPLD0,U,5))
  1.  . . . S GMPLPTL4=$E($$GET1^DIQ(2,$P(GMPLD0,U,2),.09),6,9) S:GMPLPTL4']"" GMPLPTL4="UNKN"
  1.  . . . S GMPLPTNM=$$EXTERNAL^DILFD(9000011,.02,"",$P(GMPLD0,U,2))_"|"_GMPLPTL4
  1.  . . . S GMPLSTAT=$$EXTERNAL^DILFD(9000011,80005,"",$P(GMPLD800,U,5))
  1.  . . . S @GMPLA@(GMPLDIV,GMPLRPR,GMPLPTNM,GMPLMDT,GMPLDA)=GMPLNARR_U_GMPLSVCA_U_GMPLCLA_U_GMPLSCTC_U_GMPLSTAT
  1.  Q
  1. REPORT(GMPLA,GMPLEDT,GMPLLDT) ; Generate report
  1.  N GMPLDIV,GMPLRTM,DIRUT,DTOUT,DUOUT,GMPLSITE,GMPLPG
  1.  N GMPLSHDR,EQLN S $P(EQLN,"-",11)="",GMPLPG=0
  1.  I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
  1.  U IO
  1.  S GMPLRTM=$$NOW^XLFDT,GMPLSITE=$S($$NAME^VASITE]"":$$NAME^VASITE,1:$P($$SITE^VASITE,U,2))
  1.  I '$D(@GMPLA) D  Q
  1.  . D HEADER("",GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG)
  1.  . W:$$CONTINUE("",GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG) !
  1.  . W:$$CONTINUE("",GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG) "No Problems found for selected parameters...",!
  1.  . I ($E(IOST)="C"),($E(IOSL,1,3)'=999) S:'+$$STOP^GMPLUTL1("",1) DIRUT=1
  1.  S GMPLDIV=0
  1.  F  S GMPLDIV=$O(@GMPLA@(GMPLDIV)) Q:GMPLDIV']""  D  Q:$D(DIRUT)
  1.  . N GMPLRPR S GMPLRPR=""
  1.  . D HEADER(GMPLDIV,GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG)
  1.  . F  S GMPLRPR=$O(@GMPLA@(GMPLDIV,GMPLRPR)) Q:GMPLRPR']""  D  Q:$D(DIRUT)
  1.  . . N GMPLPT S GMPLPT=0
  1.  . . F  S GMPLPT=$O(@GMPLA@(GMPLDIV,GMPLRPR,GMPLPT)) Q:GMPLPT']""  D  Q:$D(DIRUT)
  1.  . . . N GMPLMDT S GMPLMDT=0
  1.  . . . F  S GMPLMDT=$O(@GMPLA@(GMPLDIV,GMPLRPR,GMPLPT,GMPLMDT)) Q:+GMPLMDT'>0  D  Q:$D(DIRUT)
  1.  . . . . N GMPLDA S GMPLDA=0
  1.  . . . . F  S GMPLDA=$O(@GMPLA@(GMPLDIV,GMPLRPR,GMPLPT,GMPLMDT,GMPLDA)) Q:+GMPLDA'>0  D  Q:$D(DIRUT)
  1.  . . . . . N GMPLD,GMPLNARR,GMPLPRNM,GMPLPTNM,GMPLSVC,GMPLCLOC,GMPLSCTC,GMPLICD,GMPLSTAT,GMPLNI
  1.  . . . . . S GMPLD=$G(@GMPLA@(GMPLDIV,GMPLRPR,GMPLPT,GMPLMDT,GMPLDA))
  1.  . . . . . S GMPLNARR=$$WRAP^GMPLX1($P(GMPLD,U),76),GMPLSVC=$P(GMPLD,U,2),GMPLCLOC=$P(GMPLD,U,3),GMPLSCTC=$P(GMPLD,U,4)
  1.  . . . . . S GMPLSTAT=$P(GMPLD,U,5),GMPLICD=$S(+GMPLSCTC:$$GETDX^GMPLX(GMPLSCTC,"SCT"),1:"")
  1.  . . . . . I +$$CONTINUE(GMPLDIV,GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG)'>0!$D(DIRUT) Q
  1.  . . . . . W $E($$NAME^GMPLUTL1(GMPLRPR,"LAST"),1,10),$$NAME^GMPLUTL1(GMPLRPR,",FI MI")
  1.  . . . . . W ?16,$E($$NAME^GMPLUTL1($P(GMPLPT,"|"),"LAST"),1,10),$$NAME^GMPLUTL1($P(GMPLPT,"|"),",FI MI"),?31," (",$P(GMPLPT,"|",2),")"
  1.  . . . . . W ?40,$$DATE^GMPLUTL1(GMPLMDT,"MM/DD/YY"),?50,GMPLSVC,?58,GMPLCLOC,?70,GMPLSTAT,!
  1.  . . . . . F GMPLNI=1:1:$L(GMPLNARR,"|") D  Q:$D(DIRUT)
  1.  . . . . . . I +$$CONTINUE(GMPLDIV,GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG)'>0!$D(DIRUT) Q
  1.  . . . . . . W ?2,$P(GMPLNARR,"|",GMPLNI),!
  1.  . . . . . I +$$CONTINUE(GMPLDIV,GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG)'>0!$D(DIRUT) Q
  1.  . . . . . W ?2,"SCT: ",GMPLSCTC,?25," ==> ",?40,GMPLICD,!
  1.  . . . . . Q:(+$$CONTINUE(GMPLDIV,GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG)'>0)!$D(DIRUT)  W !
  1.  . Q:$D(DIRUT)
  1.  . I ($E(IOST)="C"),($E(IOSL,1,3)'=999) S:'+$$STOP^GMPLUTL1("",1) DIRUT=1
  1.  Q
  1. CONTINUE(GMPLDIV,GMPLRTM,GMPLEDT,GMPLLDT,GMPLPG) ; Evaluate relative page position
  1.  N GMPLY S GMPLY=1
  1.  I $Y'>(IOSL-3) G CONTX
  1.  I $E(IOST)="C" S GMPLY=+$$READ^GMPLUTL1("E") S:$D(DIRUT) GMPLY=0
  1.  I GMPLY'>0 G CONTX
  1.  D HEADER(GMPLDIV,GMPLRTM,GMPLEDT,GMPLLDT,.GMPLPG)
  1. CONTX Q GMPLY
  1.  N GMPLLINE,GMPLDTR S $P(GMPLLINE,"=",81)="",GMPLDTR=$$DATE^GMPLUTL1(GMPLEDT,"MM/DD/CCYY")_" to "_$$DATE^GMPLUTL1(GMPLLDT,"MM/DD/CCYY")
  1.  S GMPLPG=GMPLPG+1
  1.  W @IOF D JUSTIFY^GMPLUTL1("Page "_GMPLPG,"R") W !
  1.  W GMPLLINE,! D JUSTIFY^GMPLUTL1($$TITLE^GMPLUTL1("PROBLEM LIST NTRT MAPPING REPORT"),"C") W !
  1.  D JUSTIFY^GMPLUTL1(DIVISION,"C")
  1.  W !
  1.  W "for Problems Modified: ",GMPLDTR,?55,"Printed: ",$$DATE^GMPLUTL1(GMPLRTM,"MM/DD/CCYY HR:MIN"),!
  1.  W !
  1.  W "Provider",?16,"Patient",?40,"Modified",?50,"Service",?58,"Clinic",?70,"NTRT Map",!
  1.  W ?2,"Narrative",?70,"Status",!
  1.  W GMPLLINE,!
  1.  Q