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

LA7SRPT1.m

Go to the documentation of this file. 
  1. LA7SRPT1 ;DALOI/JDB - SHIPPING MGR REPORTS (CONT) ; 3/13/07 3:00pm
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
  1.  ;
  1.  Q
  1.  ;
  1. EN ;
  1.  ; Displays data for a SHPCFG (#62.9) or a MSG PARAM (#62.48)
  1.  ; entry.  Displays all #62.9s for a #62.48 .
  1.  ; Prompts for #62.48 or #62.9, Only SCT overrides, then device.
  1.  N X,Y,%X,%Y,DIC,DIR,R6248,R629,POP,FLAGS,DTOUT,DUOUT,DIROUT,QUE,RTN
  1.  S (R629,R6248)=0
  1.  S FLAGS=""
  1.  S DIC=62.48
  1.  S DIC(0)="AENOQV"
  1.  D ^DIC
  1.  Q:$D(DTOUT)
  1.  Q:$D(DUOUT)
  1.  I Y>0 S R6248=+Y
  1.  I 'R6248 D  ;
  1.  . K DIC
  1.  . S DIC=62.9
  1.  . S DIC(0)="AENOQV"
  1.  . D ^DIC
  1.  . I Y>0 S R629=+Y
  1.  Q:$D(DTOUT)
  1.  Q:$D(DUOUT)
  1.  I 'R6248 I 'R629 Q
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Only show SCT overrides? "
  1.  S DIR("B")="N"
  1.  D ^DIR
  1.  I Y="^"!(Y="") Q
  1.  I Y S $P(FLAGS,"O",2)="" ;insert "O"
  1.  I 'Y S FLAGS=$TR(FLAGS,"O","") ;remove "O"
  1.  ;
  1.  S RTN="MAIN^LA7SRPT1("""_R629_""","""_R6248_""","""_FLAGS_""")"
  1.  S QUE=$$QUE^LRUTIL(RTN,"SHIPPING CONFIG PRINT")
  1.  Q:QUE=-1
  1.  Q:QUE>0
  1.  D MAIN(R629,R6248,FLAGS)
  1.  I $E(IOST,1,2)="C-" D MORE^LRUTIL()
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. MAIN(R629,R6248,FLAGS) ;
  1.  ; Setup variables and branch to proper display method.
  1.  ; private method
  1.  ; Inputs
  1.  ;   R629 : <opt> #62.9 IEN (need R629 or R6248)
  1.  ;  R6248 : <opt> #62.48 IEN
  1.  ;  FLAGS : <opt> Flags (O=Only print SCT Overrides)
  1.  ;
  1.  N STOP,PGDATA
  1.  S R629=$G(R629)
  1.  S R6248=$G(R6248)
  1.  S FLAGS=$G(FLAGS)
  1.  U IO
  1.  S STOP=0
  1.  S PGDATA("RPTDT")=$$NOW^XLFDT() ;Report Date
  1.  S PGDATA("PGNUM")=1 ;Page Number
  1.  S PGDATA("BM")=0 ;Bottom Margin (lines from bottom)
  1.  S PGDATA("HDR")="D HDR^LA7SRPT1" ;Header exec code
  1.  S PGDATA("FTR")="D FTR^LA7SRPT1" ; Footer exec code
  1.  D HDR^LA7SRPT1
  1.  I R629 D SHPCFG(R629,FLAGS,.STOP)
  1.  I R6248 D LOOP(R6248,FLAGS,.STOP)
  1.  ; Write last footer if needed
  1.  I 'STOP I '$G(PGDATA("WFTR")) D  ;
  1.  . I $G(PGDATA("FTR"))="" Q
  1.  . I $E($G(IOST),1,2)'="C-" D  ;
  1.  . . N I,BM
  1.  . . S BM=$G(PGDATA("BM"))
  1.  . . F I=$Y+1:1:($G(IOSL,60)-BM-1) W !
  1.  . X PGDATA("FTR")
  1.  ;
  1.  I $D(ZTQUEUED) D  ;
  1.  . S ZTREQ="@"
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. LOOP(R6248,FLAGS,STOP) ;
  1.  ; Displays all SHP CFGs (#62.9) for a MSG CFG (#62.48) entry
  1.  ; private method
  1.  ; Inputs
  1.  ; R6248 : #62.48 IEN
  1.  ; FLAGS : <opt> O=Only show tests with SCT override
  1.  ;  STOP : <byref> See Outputs
  1.  ; Outputs
  1.  ;  STOP : User wants to stop display -- 1=stop
  1.  ;
  1.  N R629
  1.  S R629=0
  1.  F  S R629=$O(^LAHM(62.9,"AC",R6248,R629)) Q:'R629  D  Q:STOP  ;
  1.  . D SHPCFG(R629,FLAGS,.STOP)
  1.  . Q:STOP
  1.  . I $O(^LAHM(62.9,"AC",R6248,R629)) W !!
  1.  Q
  1.  ;
  1. SHPCFG(R629,FLAGS,STOP) ;
  1.  ; Displays SHIPPING CONFIG (#62.9) entry info
  1.  ; private method
  1.  ; Inputs
  1.  ;  R629 : #62.9 IEN
  1.  ; FLAGS : <opt> O=Only show tests with SCT override
  1.  ;  STOP : <byref> See Outputs
  1.  ; Outputs
  1.  ;  STOP : User wants to stop display -- 1=stop
  1.  ;
  1.  N D629,D629001,D60,D64,R629001,R6248,R62482,R60,R64,X,Z,SCT,SPEC,SMPL
  1.  N CNT,WTEST,ISMAPPED,LAIEN,STR
  1.  S FLAGS=$G(FLAGS)
  1.  S STOP=$G(STOP)
  1.  S CNT=0
  1.  D GETFLDS(62.9,R629,".01;.07",.D629)
  1.  Q:'$D(D629)
  1.  S R6248=$G(D629(.07,"I"))
  1.  Q:'R6248
  1.  D NP Q:STOP
  1.  W !,"Shipping Configuration: ",D629(.01,"E")
  1.  D NP Q:STOP
  1.  I FLAGS["O" I '$D(^LAHM(62.48,R6248,"SCT","B")) D  Q  ;
  1.  . W !?5,"No SCT overrides in ",D629(.07,"E")
  1.  ;
  1.  D NP Q:STOP
  1.  S R629001=0
  1.  F  S R629001=$O(^LAHM(62.9,R629,60,R629001)) Q:'R629001  D  Q:STOP  ;
  1.  . S ISMAPPED=0
  1.  . S WTEST=0 ;wrote test's header
  1.  . K D629001
  1.  . S LAIEN=R629001_","_R629_","
  1.  . D GETFLDS(62.9001,LAIEN,".01;.03;.09;",.D629001)
  1.  . S LAIEN=R629001_","_R629_","
  1.  . D GETFLDS(62.9001,LAIEN,".01;.03;.09;5.3;5.4;5.6;5.7;5.8;5.9;5.1;5.2;5.5",.D629001)
  1.  . ;S D629001(.01,"E")=D629001(.01,"E")_"1234 56789 123 23345667533 123.2234 4567543 555 6675433 "
  1.  . D NP Q:STOP
  1.  . I '$D(D629001) D  Q  ;
  1.  . . W !?8,"No Tests for this configuration."
  1.  . S R60=D629001(.01,"I")
  1.  . K D60
  1.  . D GETFLDS(60,R60,".01;64",.D60)
  1.  . S R64=$G(D60(64,"I"))
  1.  . K D64
  1.  . I R64 D  ;
  1.  . . D GETFLDS(64,R64,".01;1",.D64)
  1.  . I FLAGS'["O" D  ;
  1.  . . I CNT>0 W !
  1.  . . D NP Q:STOP
  1.  . . D WTEST S WTEST=1
  1.  . ;
  1.  . D NP Q:STOP
  1.  . S SPEC=$G(D629001(.03,"I"))
  1.  . S SMPL=$G(D629001(.09,"I"))
  1.  . I SPEC D  ;
  1.  . . S X=SPEC_";LAB(61,"
  1.  . . S R62482=$$ISMAPPED(R6248,X)
  1.  . . I FLAGS["O" Q:'R62482
  1.  . . I R62482 S ISMAPPED=1
  1.  . . I 'WTEST D  ;
  1.  . . . D NP Q:STOP
  1.  . . . I CNT>0 W !
  1.  . . . D NP Q:STOP
  1.  . . . D WTEST S WTEST=1
  1.  . . ;
  1.  . . D NP Q:STOP
  1.  . . W !?4,"Specimen: " ;,D629001(.03,"E")
  1.  . . S STR=D629001(.03,"E")
  1.  . . S SCT=$$GETSCT^LRSCT(61,SPEC)
  1.  . . I SCT'="" S STR=STR_" ("_SCT_" "_$$GETPREF^LRSCT(SCT)_")"
  1.  . . D WRAP(STR,15)
  1.  . . S STR=$G(D629001(5.3,"E"),"")_" | "_$G(D629001(5.4,"E"),"")_" | "_$G(D629001(5.6,"E"),"")
  1.  . . I $TR(STR,"| ","")'="" W !?6,"HL7 Info: ",STR
  1.  . . D NP Q:STOP
  1.  . . Q:'R62482
  1.  . . D NP Q:STOP
  1.  . . S SCT=$$GETMAP(R6248,R62482)
  1.  . . S STR=SCT_" "_$$GETPREF^LRSCT(SCT)
  1.  . . W !?6,"SCT override: "
  1.  . . D WRAP(STR,21)
  1.  . . D NP Q:STOP
  1.  . ;
  1.  . D NP Q:STOP
  1.  . ;
  1.  . I SMPL D  ;
  1.  . . S X=SMPL_";LAB(62,"
  1.  . . S R62482=$$ISMAPPED(R6248,X)
  1.  . . I FLAGS["O" Q:'R62482
  1.  . . S ISMAPPED=1
  1.  . . I 'WTEST  D  ;
  1.  . . . W:CNT>0 !
  1.  . . . D NP Q:STOP
  1.  . . . D WTEST S WTEST=1
  1.  . . ;
  1.  . . W !?4,"Sample: ",D629001(.09,"E")
  1.  . . S SCT=$$GETSCT^LRSCT(62,SMPL)
  1.  . . I SCT'="" W " (",SCT," ",$$GETPREF^LRSCT(SCT),")"
  1.  . . D NP Q:STOP
  1.  . . S STR=$G(D629001(5.7,"E"),"")_" | "_$G(D629001(5.8,"E"),"")_" | "_$G(D629001(5.9,"E"),"")
  1.  . . I $TR(STR,"| ","")'="" W !?6,"HL7 Info: ",STR
  1.  . . D NP Q:STOP
  1.  . . Q:'R62482
  1.  . . S SCT=$$GETMAP(R6248,R62482)
  1.  . . W !?6,"SCT override: "
  1.  . . S STR=SCT_" "_$$GETPREF^LRSCT(SCT)
  1.  . . D WRAP(STR,21)
  1.  . . D NP Q:STOP
  1.  . ;
  1.  . D NP Q:STOP
  1.  . I FLAGS'["O" S CNT=CNT+1
  1.  . I FLAGS["O" I ISMAPPED S CNT=CNT+1
  1.  Q
  1.  ;
  1. WTEST ;
  1.  ; Displays the "top-level" test info
  1.  ; Expects the D64 and D629001 arrays
  1.  ; private method
  1.  N STR
  1.  D NP Q:STOP
  1.  W !?2,"Test: ",D629001(.01,"E")
  1.  D NP Q:STOP
  1.  I $D(D64) W !?2,D64(.01,"E")," (",D64(1,"E"),")"
  1.  D NP Q:STOP
  1.  ;test order code
  1.  S STR=$G(D629001(5.1,"E"))_" | "_$G(D629001(5.2,"E"))_" | "_$G(D629001(5.5,"E"))
  1.  I $TR(STR," |","")'="" W !,?2,"Order Code: ",STR
  1.  D NP Q:STOP
  1.  Q
  1.  ;
  1. GETFLDS(LAFILE,LAIEN,LAFLDS,DATA) ;
  1.  ; Fields retriever
  1.  ; Inputs
  1.  ;  LAFILE : File #
  1.  ;   LAIEN : IEN
  1.  ;  LAFLDS : Field #s to retrieve ie ".01;.02;1"
  1.  ;    DATA : <byref> See Outputs
  1.  ; Outputs
  1.  ;    DATA : Array that holds the internal and external field values
  1.  ;         :  ie  DATA(.01,"I")=1  DATA(.01,"E")="value"
  1.  N DIERR,LAMSG,LAFDA,LATARG
  1.  S LAFILE=$G(LAFILE)
  1.  S LAIEN=$G(LAIEN)
  1.  S:LAIEN'["," LAIEN=LAIEN_","
  1.  K DATA
  1.  D GETS^DIQ(LAFILE,LAIEN,LAFLDS,"EIN","LATARG","LAMSG")
  1.  I $D(LATARG) M DATA=LATARG(LAFILE,LAIEN)
  1.  Q
  1.  ;
  1. ISMAPPED(R6248,VARPTR) ;
  1.  ; Is this VARPTR (spec or sample) an entry in #62.482?
  1.  ; Inputs
  1.  ;  R6248 : #62.48 IEN
  1.  ; VARPTR : Pointer to file #61 or #62 -- ie "123;LAB(61,"
  1.  ; Output
  1.  ;  0 or the #62.482 IEN of the VARPTR
  1.  Q +$O(^LAHM(62.48,R6248,"SCT","B",VARPTR,0))
  1.  ;
  1. GETMAP(R6248,R62482) ;
  1.  ; Returns the SCT code in #62.482
  1.  N DIERR,LAMSG,LAIEN
  1.  S LAIEN=R62482_","_R6248_","
  1.  Q $$GET1^DIQ(62.482,LAIEN,.02,"LAMSG")
  1.  ;
  1. HDR ;
  1.  ; Header
  1.  ; Expects PGDATA array
  1.  ; private method
  1.  N STR,RPTDT,PGNUM
  1.  S RPTDT=$G(PGDATA("RPTDT"))
  1.  I RPTDT="" D  ;
  1.  . S RPTDT=$$NOW^XLFDT()
  1.  . S PGDATA("RPTDT")=RPTDT
  1.  S PGNUM=$G(PGDATA("PGNUM"))
  1.  I PGNUM<1 D  ;
  1.  . S PGNUM=1
  1.  . S PGDATA("PGNUM")=PGNUM
  1.  ;
  1.  W !,"SHIPPING CONFIGURATION DISPLAY  "
  1.  S STR="Printed "_$$FMTE^XLFDT(RPTDT,"M")
  1.  S STR=STR_"   Page "_$G(PGNUM,1)
  1.  W ?IOM-$L(STR)-2,STR
  1.  W !,$$REPEAT^XLFSTR("=",IOM)
  1.  Q
  1.  ;
  1. FTR ;
  1.  ; Footer
  1.  ; private method
  1.  Q
  1.  ;
  1. NP ;
  1.  ; New Page handler
  1.  ; convenience method
  1.  D NP^LRUTIL(.STOP,.PGDATA)
  1.  Q
  1.  ;
  1. WRAP(STR,LM,NL,ABORT,PGDATA) ;
  1.  ; Formats (wraps) and prints a string
  1.  ; Depending on desired output, caller may need to position
  1.  ; the cursor at desired column (W ?X) before calling WRAP.
  1.  ; Inputs
  1.  ;  STR : The string to format
  1.  ;   LM : Left Margin (align to column X)
  1.  ;   NL : New Line?  0=no 1=yes (Write a new line first)
  1.  ;
  1.  N I,J,X,STR2,DIWL,DIWR,DIWF,SPLIT,CHARS,Z
  1.  S STR=$G(STR)
  1.  S LM=$G(LM,1)
  1.  S NL=$G(NL)
  1.  S ABORT=$G(ABORT)
  1.  K ^UTILITY($J,"W") ;per FM
  1.  S CHARS=" .-!+""" ; chars to split on
  1.  S X=STR
  1.  ; display 1st line manually since DIWW doesnt work well here
  1.  S STR2=$E(STR,1,IOM-$X)
  1.  S X=$E(STR,$L(STR2)+1,$L(STR2)+1) ;next char
  1.  I CHARS'[X D  ; chars to break on
  1.  . S SPLIT=0
  1.  . F I=$L(STR2):-1:1 S X=$E(STR2,I,I) I CHARS[X S SPLIT=1 Q
  1.  . I SPLIT S STR2=$E(STR2,1,I)
  1.  I NL W !
  1.  W STR2
  1.  S STR2=$E(STR,$L(STR2)+1,$L(STR))
  1.  S STR2=$$TRIM^XLFSTR(STR2,"LR"," ")
  1.  Q:STR2=""
  1.  S X=STR2
  1.  S DIWL=LM
  1.  S:DIWL<1 DIWL=1
  1.  S DIWR=IOM
  1.  S DIWF=""
  1.  D ^DIWP
  1.  ; DIWW forces an extra linefeed at end so printout manually
  1.  S I=$O(^UTILITY($J,"W",0))
  1.  S J=0
  1.  F  S J=$O(^UTILITY($J,"W",I,J)) Q:'J  D  Q:ABORT  ;
  1.  . S X=^UTILITY($J,"W",I,J,0)
  1.  . S X=$$TRIM^XLFSTR(X,"RL"," ")
  1.  . D NP^LRUTIL(.ABORT,.PGDATA) Q:ABORT
  1.  . W !,?LM-1,X
  1.  K ^UTILITY($J,"W")
  1.  Q