- BLRRLTDU ; IHS/MSC/MKK - Reference Lab Test Delete Utilities ; 22-Oct-2013 09:22 ; MKK
- ;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997
- ;
- EEP ; Ersatz EP
- D EEP^BLRGMENU
- Q
- ;
- ; Parameters:
- ; F60IEN = Pointer to entry in file 60
- ; LRAS = Accession Number
- ; MSG = Message # in file 62.49
- ; TYPE = "A" - for ADDING test to an acceession
- ; = "N" - for marking test as NOT PERFORMED
- STORTXNS(F60IEN,LRAS,TYPE) ; EP - Set data when Reference Lab update successful
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,F60IEN,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRAS,TYPE,U,XPARSYS,XQXFLG)
- ;
- S STR=$G(^XTMP("BLRRLTMR",0))
- I $L(STR)<1 D ; Set ^XTMP Node Zero
- . S STR=$$HTFM^XLFDT(+$H)_"^^Reference Lab 'Not Performed' Update"
- S $P(STR,"^",2)=$$HTFM^XLFDT(+$H+30)
- S ^XTMP("BLRRLTMR",0)=STR
- ;
- ; Set the LRAA,LRAD,LRAN variables from the Accession number
- S X=$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)
- ;
- S UID=$G(^LRO(68,+$G(LRAA),1,+$G(LRAD),1,+$G(LRAN),.3),"<UNKNOWN>"),ORDER=$G(^(.1),"<UNKNOWN>")
- ;
- S (LRDFN,LRIDT,LRSS)="<UNKNOWN>"
- I +LRAA,+LRAD,+LRAN D
- . S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5)
- . S LRSS=$P($G(^LRO(68,LRAA,0)),"^",2)
- ;
- S ^XTMP("BLRRLTMR",$H,TYPE,LRAS,F60IEN)=UID_"^"_ORDER_"^"_LRDFN_"^"_LRSS_"^"_LRIDT
- S LREND=1
- ;
- Q
- ;
- TXNSREPT ; EP - Report on Reference Lab successful updates
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- Q:$$TXNSRPTI()="Q"
- ;
- F S THEN=$O(^XTMP("BLRRLTMR",THEN),-1) Q:THEN=""!(QFLG="Q") D
- . S TYPE=""
- . F S TYPE=$O(^XTMP("BLRRLTMR",THEN,TYPE)) Q:TYPE=""!(QFLG="Q") D
- .. S LRAS=""
- .. F S LRAS=$O(^XTMP("BLRRLTMR",THEN,TYPE,LRAS)) Q:LRAS=""!(QFLG="Q") D
- ... S F60IEN=0
- ... F S F60IEN=$O(^XTMP("BLRRLTMR",THEN,TYPE,LRAS,F60IEN)) Q:F60IEN<1!(QFLG="Q") D TXNSRPTL
- ;
- W:CNT&(QFLG'="Q") !!,?4,"Number of successful updates = ",CNT,!
- ;
- D ^%ZISC
- ;
- D:QFLG'="Q" PRESSKEY^BLRGMENU(9)
- Q
- ;
- TXNSRPTI() ; EP - Initialization
- S BLRVERN=$TR($P($T(+1),";")," ")
- S BLRVERN2="TXNSREPT"
- ;
- S HEADER(1)="Reference Lab successful updates"
- S HEADER(2)="Set Test to 'Not Performed' (NP) OR Added Test"
- ;
- D HEADERDT^BLRGMENU
- D HEADONE^BLRGMENU(.HEADONE)
- ;
- S HEADER(3)=" "
- S $E(HEADER(4),53)=$TR($$CJ^XLFSTR("@File@60@",27)," @","= ")
- S HEADER(5)="Entry Date/Time"
- S $E(HEADER(5),25)="Type"
- S $E(HEADER(5),33)="Accession Number"
- S $E(HEADER(5),53)="IEN"
- S $E(HEADER(5),63)="Description"
- ;
- D ^%ZIS
- I POP D Q "Q"
- . W !!,?4,"Device Issue. POP postive. Routine Ends."
- . D PRESSKEY^BLRGMENU(9)
- ;
- U IO
- ;
- S MAXLINES=IOSL-4,LINES=MAXLINES+10
- S (CNT,PG)=0,QFLG="NO"
- S THEN="A"
- ;
- Q "OK"
- ;
- TXNSRPTL ; EP - Line of Data
- Q:$$TXNSRPTB<1
- ;
- I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HEADONE) Q:QFLG="Q"
- ;
- W EXTDATE
- W ?25,TYPEDESC
- W ?32,LRAS
- W ?52,F60IEN
- W ?62,F60DESC
- W !
- S LINES=LINES+1
- S CNT=CNT+1
- ;
- Q
- ;
- TXNSRPTB() ; EP - "Break out" variables for report
- S EXTDATE=$$HTE^XLFDT(THEN,"2MZ")
- S TYPEDESC=$S(TYPE="A":"ADD",TYPE="N":"NP",1:"<>")
- S F60DESC=$$GET1^DIQ(60,F60IEN,"NAME")
- S:$L(F60DESC)>18 F60DESC=$$GET1^DIQ(60,F60IEN,"PRINT NAME")
- Q 1
- ;
- XTMPNSET(F60IEN,MSG) ; EP - Set data in ^XTMP when "Not Performed" update successful
- NEW UID,STR
- ;
- S STR=$G(^XTMP("BLRRLTDS",0))
- I $L(STR)<1 D ; Set ^XTMP Node Zero
- . S STR=$$HTFM^XLFDT(+$H)_"^^Reference Lab 'Not Performed' Update"
- S $P(STR,"^",2)=$$HTFM^XLFDT(+$H+30)
- S ^XTMP("BLRRLTDS",0)=STR
- ;
- S UID=$G(^LRO(68,+$G(LRAA),1,+$G(LRAD),1,+$G(LRAN),.3),"<UNKNOWN>")
- S ^XTMP("BLRRLTDS","UID",UID,"DUZ",DUZ,$H,F60IEN)=MSG
- S ^XTMP("BLRRLTDS","UID")=1+$G(^XTMP("BLRRLTDS","UID"))
- S LREND=1
- ;
- Q
- ;
- XTMPNRPT ; EP - Report on Successfully Updated Entries
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- Q:$$XTMPNRPI()="Q"
- ;
- F S UID=$O(^XTMP("BLRRLTDS","UID",UID)) Q:UID<1!(QFLG="Q") D
- . S MSGDUZ=0
- . F S MSGDUZ=$O(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ)) Q:MSGDUZ<1!(QFLG="Q") D
- .. S NAMEDUZ=$$GET1^DIQ(200,MSGDUZ,"NAME")
- .. S HDATE=""
- .. F S HDATE=$O(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ,HDATE)) Q:HDATE=""!(QFLG="Q") D
- ... S F60IEN=0
- ... F S F60IEN=$O(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ,HDATE,F60IEN)) Q:F60IEN<1!(QFLG="Q") D XTMPNRPL
- ;
- W:QFLG'="Q" !,?4,"Number of Reference Lab Tests set to 'Not Performed' = ",CNT
- ;
- D ^%ZISC
- ;
- Q:QFLG="Q"
- ;
- D PRESSKEY^BLRGMENU(9)
- Q
- ;
- XTMPNRPI() ; EP - Initialization
- S BLRVERN=$TR($P($T(+1),";")," ")
- ;
- S HEADER(1)=$$GET1^DIQ(9009029,DUZ(2),3001)_" Reference Lab: 'Not Performed' Tests"
- S HEADER(2)="^XTMP(""BLRRLTDS"") Report"
- S HEADER(3)=" "
- ;
- D HEADERDT^BLRGMENU
- D HEADONE^BLRGMENU(.HEADONE)
- ;
- I $D(^XTMP("BLRRLTDS","UID"))<1 D Q "Q"
- . W !,?4,"No entries in ^XTMP(""BLRRLTDS"",""UID""). Routine Ends."
- . D PRESSKEY^BLRGMENU(9)
- ;
- ;1 2 3 4 5 6 7 8
- ;12345678901234567890123456789012345678901234567890123456789012345678901234567890
- ; === File 60 ==== = 62.49 =
- ;UID Date/Time DUZ IEN Prnt NM Msg # Message
- ;--------------------------------------------------------------------------------
- ;6011000078 02/25/13@09:19 2011 9999622 AER+AN 123456789 *NP:Set
- ;
- S $E(HEADER(4),38)=$TR($$CJ^XLFSTR("@Lab@Test@File@(#60)@",28)," @","= ")
- S HEADER(5)="UID"
- S $E(HEADER(5),15)="Date/Time"
- S $E(HEADER(5),31)="DUZ"
- S $E(HEADER(5),38)="IEN"
- S $E(HEADER(5),48)="Description"
- S $E(HEADER(5),68)="Msg"
- ;
- D ^%ZIS
- ;
- I POP D Q "Q"
- . W !,?4,"Issue opening device. Routine Ends."
- . D PRESSKEY^BLRGMENU(9)
- . W 1/0
- ;
- U IO
- ;
- S MAXLINES=IOSL-4,LINES=MAXLINES+10
- S (CNT,PG,UID)=0
- S QFLG="NO"
- ;
- Q "OK"
- ;
- XTMPNRPL ; EP - Line of Data
- I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HEADONE) Q:QFLG="Q"
- ;
- W UID
- W ?14,$$HTE^XLFDT(HDATE,"2MZ")
- W ?30,MSGDUZ
- W ?37,F60IEN
- W ?47,$E($$GET1^DIQ(60,F60IEN,"NAME"),1,18)
- W ?67,$G(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ,HDATE,F60IEN))
- W !
- S LINES=LINES+1
- S CNT=CNT+1
- Q
- ;
- XTMPISET(MSG,RTN) ; EP - Set data in ^XTMP when there are issues
- NEW UID,STR
- ;
- S STR=$G(^XTMP("BLRRLTDI",0))
- I $L(STR)<1 D ; Set ^XTMP Node Zero
- . S STR=$$HTFM^XLFDT(+$H)_"^^Reference Lab Errors"
- S $P(STR,"^",2)=$$HTFM^XLFDT(+$H+30)
- S ^XTMP("BLRRLTDI",0)=STR
- ;
- S UID=$G(^LRO(68,+$G(LRAA),1,+$G(LRAD),1,+$G(LRAN),.3),"<UNKNOWN>")
- S ^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZ,$H)=RTN_"^"_MSG
- S ^XTMP("BLRRLTDI","UID")=1+$G(^XTMP("BLRRLTDI","UID"))
- S LREND=1
- ;
- D:+$G(^XTMP("BLRRLTDI","UID"))>99 XTMPIRPT
- ;
- Q
- ;
- XTMPIRPT ; EP - There are 100 Entries in ^XTMP Issues node - Send Report to LMI Mail Group and CLEAR ^XTMP Issues
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- ; Create Message array
- ;
- ; HEADER
- S MESSAGE(1)=$$CJ^XLFSTR($$GET1^DIQ(9009029,DUZ(2),3001)_" Reference Lab: Issues",60)
- S MESSAGE(2)=$$CJ^XLFSTR("^XTMP Report",60)
- S MESSAGE(3)=" "
- S MESSAGE(4)="UID"
- S $E(MESSAGE(4),13)="Date/Time"
- S $E(MESSAGE(4),29)="DUZ"
- S $E(MESSAGE(4),36)="Routine"
- S $E(MESSAGE(4),46)="Message"
- S MESSAGE(5)=$TR($J("",(IOM-1))," ","-")
- ;
- ; Create the body of the Message array
- S UID=0,MSGL=5
- F S UID=$O(^XTMP("BLRRLTDI","UID",UID)) Q:UID<1 D
- . S MSGDUZ=0
- . F S MSGDUZ=$O(^XTMP("BLRRLTDI","UID",UID,"DUZ",MSGDUZ)) Q:MSGDUZ<1 D
- .. S NAMEDUZ=$$GET1^DIQ(200,MSGDUZ,"NAME")
- .. S HDATE=""
- .. F S HDATE=$O(^XTMP("BLRRLTDI","UID",UID,"DUZ",MSGDUZ,HDATE)) Q:HDATE="" D
- ... S STR=$G(^XTMP("BLRRLTDI","UID",UID,"DUZ",MSGDUZ,HDATE))
- ... S MSGL=MSGL+1
- ... S MESSAGE(MSGL)=UID
- ... S $E(MESSAGE(MSGL),13)=$$HTE^XLFDT(HDATE,"2MZ")
- ... S $E(MESSAGE(MSGL),29)=MSGDUZ
- ... S $E(MESSAGE(MSGL),36)=$P(STR,"^",2)
- ... S $E(MESSAGE(MSGL),46)=$E($P(STR,"^"),1,34)
- ;
- D SENDMAIL^BLRUTIL3($G(MESSAGE(1)),.MESSAGE,"BLRRLTDR",1)
- ;
- K ^XTMP("BLRRLTDI") ; Clear the ^XTMP global
- Q
- ;
- TXNSURPT ; EP - Report on Reference Lab Unsuccessful updates
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- Q:$$TXNURPTI()="Q"
- ;
- F S UID=$O(^XTMP("BLRRLTDI","UID",UID)) Q:UID=""!(QFLG="Q") D
- . S DUZVAR=""
- . F S DUZVAR=$O(^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZVAR)) Q:DUZVAR=""!(QFLG="Q") D
- .. S HDATE=""
- .. F S HDATE=$O(^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZVAR,HDATE)) Q:HDATE=""!(QFLG="Q") D TXNURPTL
- ;
- W:CNT&(QFLG'="Q") !!,?4,"Number of unsuccessful updates = ",CNT,!
- ;
- D ^%ZISC
- ;
- D:QFLG'="Q" PRESSKEY^BLRGMENU(9)
- Q
- ;
- TXNURPTI() ; EP - Initialization
- S BLRVERN=$TR($P($T(+1),";")," ")
- S BLRVERN2="TXNSURPT"
- ;
- S HEADER(1)="Reference Lab NON Successful Updates"
- S HEADER(2)=" "
- ;
- D HEADERDT^BLRGMENU
- D HEADONE^BLRGMENU(.HEADONE)
- ;
- S HEADER(4)="UID"
- S $E(HEADER(4),15)="DUZ"
- S $E(HEADER(4),25)="Date/Time"
- S $E(HEADER(4),43)="Routine"
- S $E(HEADER(4),53)="Message"
- ;
- D ^%ZIS
- I POP D Q "Q"
- . W !!,?4,"Device Issue. POP postive. Routine Ends."
- . D PRESSKEY^BLRGMENU(9)
- ;
- U IO
- ;
- S MAXLINES=IOSL-4,LINES=MAXLINES+10
- S (CNT,PG,THEN,UID)=0,QFLG="NO"
- ;
- Q "OK"
- ;
- TXNURPTL ; EP - Line of Data
- I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG) Q:QFLG="Q"
- ;
- D TXNURPTB
- ;
- W UID
- W ?14,DUZVAR
- W ?24,DATETIME
- W ?42,RTN
- I $L(MESSAGE)<29 W ?52,MESSAGE,! S LINES=LINES+1
- D:$L(MESSAGE)>28 LINEWRAP^BLRGMENU(52,MESSAGE,28)
- S CNT=CNT+1
- Q
- ;
- TXNURPTB ; EP - Break out data
- S DATETIME=$$HTE^XLFDT(HDATE,"5MZ")
- S STR=$G(^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZVAR,HDATE))
- S RTN=$P(STR,"^")
- S MESSAGE=$P(STR,"^",2)
- Q
- ;
- DEBUGRPT ; EP - Debug the XTMPRPT report
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- I $NAMESPACE="LABMU" D Q
- . W !!,?4,"Will not K ^XTMP(""BLRRLTDI"") nor reset it because MU testing has begun on this UCI."
- . D PRESSKEY^BLRGMENU(9)
- ;
- K ^XTMP("BLRRLTDI")
- ;
- S ^XTMP("BLRRLTDI",0)=DT_"^"_$$HTFM^XLFDT(+$H+30)_"^Reference Lab Test Delete Errors"
- ;
- ; Set the Error Messages
- S ERRMAX=1,ERRMSG(ERRMAX)="Not authorized to change test status."
- S ERRMAX=ERRMAX+1,ERRMSG(ERRMAX)="Accession has no Test."
- S ERRMAX=ERRMAX+1,ERRMSG(ERRMAX)="Someone else is working on this accession"
- S ERRMAX=ERRMAX+1,ERRMSG(ERRMAX)="Someone else is working on this data."
- S ERRMAX=ERRMAX+1,ERRMSG(ERRMAX)="Can't find Lab Data for this accession"
- S ERRMAX=ERRMAX+1,ERRMSG(ERRMAX)="There is no Order for this Accession"
- S ERRMAX=ERRMAX+1,ERRMSG(ERRMAX)="No Subscript for this Accession Area"
- ;
- ; Set the ^XTMP Array
- S CNT=0,ERR=1
- F Q:CNT>99 D
- . F S UID=$TR($J($R(10000000000),10)," ","0") Q:$D(^XTMP("BLRRLTDI","UID",UID))<1
- . S ^XTMP("BLRRLTDI","UID")=1+$G(^XTMP("BLRRLTDI","UID"))
- . ;
- . S FAKEDUZ=$TR($J($R(10000),5)," ","0")
- . S FAKERTN=$S((CNT#2):"BLRRLTDR",1:"BLRRLTAR")
- . S ^XTMP("BLRRLTDI","UID",UID,"DUZ",FAKEDUZ,$H)=ERRMSG(ERR)_"^"_FAKERTN,ERR=ERR+1 S:ERR>ERRMAX ERR=1
- . S CNT=CNT+1
- ;
- D XTMPIRPT
- ;
- Q
- ;
- DEBUG ; EP - Debug BLRRLTDR
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- K ^XTMP("BLRTRACE")
- D:$P($G(LRPARAM),"^",3)="" ^LRPARAM
- ;
- D ^XBFMK
- S DIR(0)="NO"
- S DIR("A")="Enter 62.49 Message Number"
- D ^DIR
- I +$G(DIRUT) D Q
- . W !!,?4,"No/Invalid Entry. Routine Ends."
- . D PRESSKEY^BLRGMENU(9)
- ;
- S LA76249=+$G(X)
- D PEP^BLRRLTDR
- Q
- ;
- REPORTS ; EP - Reports Menu
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- S BLRVERN=$TR($P($T(+1),";")," ")
- ;
- D ADDTMENU^BLRGMENU("TXNSREPT^BLRRLTDU","Successful Updates")
- D ADDTMENU^BLRGMENU("XTMPNRPT^BLRRLTDU","'Not Performed' Success")
- D ADDTMENU^BLRGMENU("TXNSURPT^BLRRLTDU","NON Successful updates")
- ;
- ; Main Menu driver
- D MENUDRVR^BLRGMENU("RPMS Reference Lab ","Automatic Updating Reports")
- Q
- BLRRLTDU ; IHS/MSC/MKK - Reference Lab Test Delete Utilities ; 22-Oct-2013 09:22 ; MKK
- +1 ;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997
- +2 ;
- EEP ; Ersatz EP
- +1 DO EEP^BLRGMENU
- +2 QUIT
- +3 ;
- +4 ; Parameters:
- +5 ; F60IEN = Pointer to entry in file 60
- +6 ; LRAS = Accession Number
- +7 ; MSG = Message # in file 62.49
- +8 ; TYPE = "A" - for ADDING test to an acceession
- +9 ; = "N" - for marking test as NOT PERFORMED
- STORTXNS(F60IEN,LRAS,TYPE) ; EP - Set data when Reference Lab update successful
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,F60IEN,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRAS,TYPE,U,XPARSYS,XQXFLG)
- +2 ;
- +3 SET STR=$GET(^XTMP("BLRRLTMR",0))
- +4 ; Set ^XTMP Node Zero
- IF $LENGTH(STR)<1
- Begin DoDot:1
- +5 SET STR=$$HTFM^XLFDT(+$HOROLOG)_"^^Reference Lab 'Not Performed' Update"
- End DoDot:1
- +6 SET $PIECE(STR,"^",2)=$$HTFM^XLFDT(+$HOROLOG+30)
- +7 SET ^XTMP("BLRRLTMR",0)=STR
- +8 ;
- +9 ; Set the LRAA,LRAD,LRAN variables from the Accession number
- +10 SET X=$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)
- +11 ;
- +12 SET UID=$GET(^LRO(68,+$GET(LRAA),1,+$GET(LRAD),1,+$GET(LRAN),.3),"<UNKNOWN>")
- SET ORDER=$GET(^(.1),"<UNKNOWN>")
- +13 ;
- +14 SET (LRDFN,LRIDT,LRSS)="<UNKNOWN>"
- +15 IF +LRAA
- IF +LRAD
- IF +LRAN
- Begin DoDot:1
- +16 SET LRDFN=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
- SET LRIDT=$PIECE($GET(^(3)),"^",5)
- +17 SET LRSS=$PIECE($GET(^LRO(68,LRAA,0)),"^",2)
- End DoDot:1
- +18 ;
- +19 SET ^XTMP("BLRRLTMR",$HOROLOG,TYPE,LRAS,F60IEN)=UID_"^"_ORDER_"^"_LRDFN_"^"_LRSS_"^"_LRIDT
- +20 SET LREND=1
- +21 ;
- +22 QUIT
- +23 ;
- TXNSREPT ; EP - Report on Reference Lab successful updates
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3 IF $$TXNSRPTI()="Q"
- QUIT
- +4 ;
- +5 FOR
- SET THEN=$ORDER(^XTMP("BLRRLTMR",THEN),-1)
- IF THEN=""!(QFLG="Q")
- QUIT
- Begin DoDot:1
- +6 SET TYPE=""
- +7 FOR
- SET TYPE=$ORDER(^XTMP("BLRRLTMR",THEN,TYPE))
- IF TYPE=""!(QFLG="Q")
- QUIT
- Begin DoDot:2
- +8 SET LRAS=""
- +9 FOR
- SET LRAS=$ORDER(^XTMP("BLRRLTMR",THEN,TYPE,LRAS))
- IF LRAS=""!(QFLG="Q")
- QUIT
- Begin DoDot:3
- +10 SET F60IEN=0
- +11 FOR
- SET F60IEN=$ORDER(^XTMP("BLRRLTMR",THEN,TYPE,LRAS,F60IEN))
- IF F60IEN<1!(QFLG="Q")
- QUIT
- DO TXNSRPTL
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 IF CNT&(QFLG'="Q")
- WRITE !!,?4,"Number of successful updates = ",CNT,!
- +14 ;
- +15 DO ^%ZISC
- +16 ;
- +17 IF QFLG'="Q"
- DO PRESSKEY^BLRGMENU(9)
- +18 QUIT
- +19 ;
- TXNSRPTI() ; EP - Initialization
- +1 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
- +2 SET BLRVERN2="TXNSREPT"
- +3 ;
- +4 SET HEADER(1)="Reference Lab successful updates"
- +5 SET HEADER(2)="Set Test to 'Not Performed' (NP) OR Added Test"
- +6 ;
- +7 DO HEADERDT^BLRGMENU
- +8 DO HEADONE^BLRGMENU(.HEADONE)
- +9 ;
- +10 SET HEADER(3)=" "
- +11 SET $EXTRACT(HEADER(4),53)=$TRANSLATE($$CJ^XLFSTR("@File@60@",27)," @","= ")
- +12 SET HEADER(5)="Entry Date/Time"
- +13 SET $EXTRACT(HEADER(5),25)="Type"
- +14 SET $EXTRACT(HEADER(5),33)="Accession Number"
- +15 SET $EXTRACT(HEADER(5),53)="IEN"
- +16 SET $EXTRACT(HEADER(5),63)="Description"
- +17 ;
- +18 DO ^%ZIS
- +19 IF POP
- Begin DoDot:1
- +20 WRITE !!,?4,"Device Issue. POP postive. Routine Ends."
- +21 DO PRESSKEY^BLRGMENU(9)
- End DoDot:1
- QUIT "Q"
- +22 ;
- +23 USE IO
- +24 ;
- +25 SET MAXLINES=IOSL-4
- SET LINES=MAXLINES+10
- +26 SET (CNT,PG)=0
- SET QFLG="NO"
- +27 SET THEN="A"
- +28 ;
- +29 QUIT "OK"
- +30 ;
- TXNSRPTL ; EP - Line of Data
- +1 IF $$TXNSRPTB<1
- QUIT
- +2 ;
- +3 IF LINES>MAXLINES
- DO HEADERPG^BLRGMENU(.PG,.QFLG,HEADONE)
- IF QFLG="Q"
- QUIT
- +4 ;
- +5 WRITE EXTDATE
- +6 WRITE ?25,TYPEDESC
- +7 WRITE ?32,LRAS
- +8 WRITE ?52,F60IEN
- +9 WRITE ?62,F60DESC
- +10 WRITE !
- +11 SET LINES=LINES+1
- +12 SET CNT=CNT+1
- +13 ;
- +14 QUIT
- +15 ;
- TXNSRPTB() ; EP - "Break out" variables for report
- +1 SET EXTDATE=$$HTE^XLFDT(THEN,"2MZ")
- +2 SET TYPEDESC=$SELECT(TYPE="A":"ADD",TYPE="N":"NP",1:"<>")
- +3 SET F60DESC=$$GET1^DIQ(60,F60IEN,"NAME")
- +4 IF $LENGTH(F60DESC)>18
- SET F60DESC=$$GET1^DIQ(60,F60IEN,"PRINT NAME")
- +5 QUIT 1
- +6 ;
- XTMPNSET(F60IEN,MSG) ; EP - Set data in ^XTMP when "Not Performed" update successful
- +1 NEW UID,STR
- +2 ;
- +3 SET STR=$GET(^XTMP("BLRRLTDS",0))
- +4 ; Set ^XTMP Node Zero
- IF $LENGTH(STR)<1
- Begin DoDot:1
- +5 SET STR=$$HTFM^XLFDT(+$HOROLOG)_"^^Reference Lab 'Not Performed' Update"
- End DoDot:1
- +6 SET $PIECE(STR,"^",2)=$$HTFM^XLFDT(+$HOROLOG+30)
- +7 SET ^XTMP("BLRRLTDS",0)=STR
- +8 ;
- +9 SET UID=$GET(^LRO(68,+$GET(LRAA),1,+$GET(LRAD),1,+$GET(LRAN),.3),"<UNKNOWN>")
- +10 SET ^XTMP("BLRRLTDS","UID",UID,"DUZ",DUZ,$HOROLOG,F60IEN)=MSG
- +11 SET ^XTMP("BLRRLTDS","UID")=1+$GET(^XTMP("BLRRLTDS","UID"))
- +12 SET LREND=1
- +13 ;
- +14 QUIT
- +15 ;
- XTMPNRPT ; EP - Report on Successfully Updated Entries
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3 IF $$XTMPNRPI()="Q"
- QUIT
- +4 ;
- +5 FOR
- SET UID=$ORDER(^XTMP("BLRRLTDS","UID",UID))
- IF UID<1!(QFLG="Q")
- QUIT
- Begin DoDot:1
- +6 SET MSGDUZ=0
- +7 FOR
- SET MSGDUZ=$ORDER(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ))
- IF MSGDUZ<1!(QFLG="Q")
- QUIT
- Begin DoDot:2
- +8 SET NAMEDUZ=$$GET1^DIQ(200,MSGDUZ,"NAME")
- +9 SET HDATE=""
- +10 FOR
- SET HDATE=$ORDER(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ,HDATE))
- IF HDATE=""!(QFLG="Q")
- QUIT
- Begin DoDot:3
- +11 SET F60IEN=0
- +12 FOR
- SET F60IEN=$ORDER(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ,HDATE,F60IEN))
- IF F60IEN<1!(QFLG="Q")
- QUIT
- DO XTMPNRPL
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 ;
- +14 IF QFLG'="Q"
- WRITE !,?4,"Number of Reference Lab Tests set to 'Not Performed' = ",CNT
- +15 ;
- +16 DO ^%ZISC
- +17 ;
- +18 IF QFLG="Q"
- QUIT
- +19 ;
- +20 DO PRESSKEY^BLRGMENU(9)
- +21 QUIT
- +22 ;
- XTMPNRPI() ; EP - Initialization
- +1 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
- +2 ;
- +3 SET HEADER(1)=$$GET1^DIQ(9009029,DUZ(2),3001)_" Reference Lab: 'Not Performed' Tests"
- +4 SET HEADER(2)="^XTMP(""BLRRLTDS"") Report"
- +5 SET HEADER(3)=" "
- +6 ;
- +7 DO HEADERDT^BLRGMENU
- +8 DO HEADONE^BLRGMENU(.HEADONE)
- +9 ;
- +10 IF $DATA(^XTMP("BLRRLTDS","UID"))<1
- Begin DoDot:1
- +11 WRITE !,?4,"No entries in ^XTMP(""BLRRLTDS"",""UID""). Routine Ends."
- +12 DO PRESSKEY^BLRGMENU(9)
- End DoDot:1
- QUIT "Q"
- +13 ;
- +14 ;1 2 3 4 5 6 7 8
- +15 ;12345678901234567890123456789012345678901234567890123456789012345678901234567890
- +16 ; === File 60 ==== = 62.49 =
- +17 ;UID Date/Time DUZ IEN Prnt NM Msg # Message
- +18 ;--------------------------------------------------------------------------------
- +19 ;6011000078 02/25/13@09:19 2011 9999622 AER+AN 123456789 *NP:Set
- +20 ;
- +21 SET $EXTRACT(HEADER(4),38)=$TRANSLATE($$CJ^XLFSTR("@Lab@Test@File@(#60)@",28)," @","= ")
- +22 SET HEADER(5)="UID"
- +23 SET $EXTRACT(HEADER(5),15)="Date/Time"
- +24 SET $EXTRACT(HEADER(5),31)="DUZ"
- +25 SET $EXTRACT(HEADER(5),38)="IEN"
- +26 SET $EXTRACT(HEADER(5),48)="Description"
- +27 SET $EXTRACT(HEADER(5),68)="Msg"
- +28 ;
- +29 DO ^%ZIS
- +30 ;
- +31 IF POP
- Begin DoDot:1
- +32 WRITE !,?4,"Issue opening device. Routine Ends."
- +33 DO PRESSKEY^BLRGMENU(9)
- +34 WRITE 1/0
- End DoDot:1
- QUIT "Q"
- +35 ;
- +36 USE IO
- +37 ;
- +38 SET MAXLINES=IOSL-4
- SET LINES=MAXLINES+10
- +39 SET (CNT,PG,UID)=0
- +40 SET QFLG="NO"
- +41 ;
- +42 QUIT "OK"
- +43 ;
- XTMPNRPL ; EP - Line of Data
- +1 IF LINES>MAXLINES
- DO HEADERPG^BLRGMENU(.PG,.QFLG,HEADONE)
- IF QFLG="Q"
- QUIT
- +2 ;
- +3 WRITE UID
- +4 WRITE ?14,$$HTE^XLFDT(HDATE,"2MZ")
- +5 WRITE ?30,MSGDUZ
- +6 WRITE ?37,F60IEN
- +7 WRITE ?47,$EXTRACT($$GET1^DIQ(60,F60IEN,"NAME"),1,18)
- +8 WRITE ?67,$GET(^XTMP("BLRRLTDS","UID",UID,"DUZ",MSGDUZ,HDATE,F60IEN))
- +9 WRITE !
- +10 SET LINES=LINES+1
- +11 SET CNT=CNT+1
- +12 QUIT
- +13 ;
- XTMPISET(MSG,RTN) ; EP - Set data in ^XTMP when there are issues
- +1 NEW UID,STR
- +2 ;
- +3 SET STR=$GET(^XTMP("BLRRLTDI",0))
- +4 ; Set ^XTMP Node Zero
- IF $LENGTH(STR)<1
- Begin DoDot:1
- +5 SET STR=$$HTFM^XLFDT(+$HOROLOG)_"^^Reference Lab Errors"
- End DoDot:1
- +6 SET $PIECE(STR,"^",2)=$$HTFM^XLFDT(+$HOROLOG+30)
- +7 SET ^XTMP("BLRRLTDI",0)=STR
- +8 ;
- +9 SET UID=$GET(^LRO(68,+$GET(LRAA),1,+$GET(LRAD),1,+$GET(LRAN),.3),"<UNKNOWN>")
- +10 SET ^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZ,$HOROLOG)=RTN_"^"_MSG
- +11 SET ^XTMP("BLRRLTDI","UID")=1+$GET(^XTMP("BLRRLTDI","UID"))
- +12 SET LREND=1
- +13 ;
- +14 IF +$GET(^XTMP("BLRRLTDI","UID"))>99
- DO XTMPIRPT
- +15 ;
- +16 QUIT
- +17 ;
- XTMPIRPT ; EP - There are 100 Entries in ^XTMP Issues node - Send Report to LMI Mail Group and CLEAR ^XTMP Issues
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3 ; Create Message array
- +4 ;
- +5 ; HEADER
- +6 SET MESSAGE(1)=$$CJ^XLFSTR($$GET1^DIQ(9009029,DUZ(2),3001)_" Reference Lab: Issues",60)
- +7 SET MESSAGE(2)=$$CJ^XLFSTR("^XTMP Report",60)
- +8 SET MESSAGE(3)=" "
- +9 SET MESSAGE(4)="UID"
- +10 SET $EXTRACT(MESSAGE(4),13)="Date/Time"
- +11 SET $EXTRACT(MESSAGE(4),29)="DUZ"
- +12 SET $EXTRACT(MESSAGE(4),36)="Routine"
- +13 SET $EXTRACT(MESSAGE(4),46)="Message"
- +14 SET MESSAGE(5)=$TRANSLATE($JUSTIFY("",(IOM-1))," ","-")
- +15 ;
- +16 ; Create the body of the Message array
- +17 SET UID=0
- SET MSGL=5
- +18 FOR
- SET UID=$ORDER(^XTMP("BLRRLTDI","UID",UID))
- IF UID<1
- QUIT
- Begin DoDot:1
- +19 SET MSGDUZ=0
- +20 FOR
- SET MSGDUZ=$ORDER(^XTMP("BLRRLTDI","UID",UID,"DUZ",MSGDUZ))
- IF MSGDUZ<1
- QUIT
- Begin DoDot:2
- +21 SET NAMEDUZ=$$GET1^DIQ(200,MSGDUZ,"NAME")
- +22 SET HDATE=""
- +23 FOR
- SET HDATE=$ORDER(^XTMP("BLRRLTDI","UID",UID,"DUZ",MSGDUZ,HDATE))
- IF HDATE=""
- QUIT
- Begin DoDot:3
- +24 SET STR=$GET(^XTMP("BLRRLTDI","UID",UID,"DUZ",MSGDUZ,HDATE))
- +25 SET MSGL=MSGL+1
- +26 SET MESSAGE(MSGL)=UID
- +27 SET $EXTRACT(MESSAGE(MSGL),13)=$$HTE^XLFDT(HDATE,"2MZ")
- +28 SET $EXTRACT(MESSAGE(MSGL),29)=MSGDUZ
- +29 SET $EXTRACT(MESSAGE(MSGL),36)=$PIECE(STR,"^",2)
- +30 SET $EXTRACT(MESSAGE(MSGL),46)=$EXTRACT($PIECE(STR,"^"),1,34)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +31 ;
- +32 DO SENDMAIL^BLRUTIL3($GET(MESSAGE(1)),.MESSAGE,"BLRRLTDR",1)
- +33 ;
- +34 ; Clear the ^XTMP global
- KILL ^XTMP("BLRRLTDI")
- +35 QUIT
- +36 ;
- TXNSURPT ; EP - Report on Reference Lab Unsuccessful updates
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3 IF $$TXNURPTI()="Q"
- QUIT
- +4 ;
- +5 FOR
- SET UID=$ORDER(^XTMP("BLRRLTDI","UID",UID))
- IF UID=""!(QFLG="Q")
- QUIT
- Begin DoDot:1
- +6 SET DUZVAR=""
- +7 FOR
- SET DUZVAR=$ORDER(^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZVAR))
- IF DUZVAR=""!(QFLG="Q")
- QUIT
- Begin DoDot:2
- +8 SET HDATE=""
- +9 FOR
- SET HDATE=$ORDER(^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZVAR,HDATE))
- IF HDATE=""!(QFLG="Q")
- QUIT
- DO TXNURPTL
- End DoDot:2
- End DoDot:1
- +10 ;
- +11 IF CNT&(QFLG'="Q")
- WRITE !!,?4,"Number of unsuccessful updates = ",CNT,!
- +12 ;
- +13 DO ^%ZISC
- +14 ;
- +15 IF QFLG'="Q"
- DO PRESSKEY^BLRGMENU(9)
- +16 QUIT
- +17 ;
- TXNURPTI() ; EP - Initialization
- +1 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
- +2 SET BLRVERN2="TXNSURPT"
- +3 ;
- +4 SET HEADER(1)="Reference Lab NON Successful Updates"
- +5 SET HEADER(2)=" "
- +6 ;
- +7 DO HEADERDT^BLRGMENU
- +8 DO HEADONE^BLRGMENU(.HEADONE)
- +9 ;
- +10 SET HEADER(4)="UID"
- +11 SET $EXTRACT(HEADER(4),15)="DUZ"
- +12 SET $EXTRACT(HEADER(4),25)="Date/Time"
- +13 SET $EXTRACT(HEADER(4),43)="Routine"
- +14 SET $EXTRACT(HEADER(4),53)="Message"
- +15 ;
- +16 DO ^%ZIS
- +17 IF POP
- Begin DoDot:1
- +18 WRITE !!,?4,"Device Issue. POP postive. Routine Ends."
- +19 DO PRESSKEY^BLRGMENU(9)
- End DoDot:1
- QUIT "Q"
- +20 ;
- +21 USE IO
- +22 ;
- +23 SET MAXLINES=IOSL-4
- SET LINES=MAXLINES+10
- +24 SET (CNT,PG,THEN,UID)=0
- SET QFLG="NO"
- +25 ;
- +26 QUIT "OK"
- +27 ;
- TXNURPTL ; EP - Line of Data
- +1 IF LINES>MAXLINES
- DO HEADERPG^BLRGMENU(.PG,.QFLG)
- IF QFLG="Q"
- QUIT
- +2 ;
- +3 DO TXNURPTB
- +4 ;
- +5 WRITE UID
- +6 WRITE ?14,DUZVAR
- +7 WRITE ?24,DATETIME
- +8 WRITE ?42,RTN
- +9 IF $LENGTH(MESSAGE)<29
- WRITE ?52,MESSAGE,!
- SET LINES=LINES+1
- +10 IF $LENGTH(MESSAGE)>28
- DO LINEWRAP^BLRGMENU(52,MESSAGE,28)
- +11 SET CNT=CNT+1
- +12 QUIT
- +13 ;
- TXNURPTB ; EP - Break out data
- +1 SET DATETIME=$$HTE^XLFDT(HDATE,"5MZ")
- +2 SET STR=$GET(^XTMP("BLRRLTDI","UID",UID,"DUZ",DUZVAR,HDATE))
- +3 SET RTN=$PIECE(STR,"^")
- +4 SET MESSAGE=$PIECE(STR,"^",2)
- +5 QUIT
- +6 ;
- DEBUGRPT ; EP - Debug the XTMPRPT report
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3
- *** ERROR ***
- IF $NAMESPACE="LABMU"
- Begin DoDot:1
- +4 WRITE !!,?4,"Will not K ^XTMP(""BLRRLTDI"") nor reset it because MU testing has begun on this UCI."
- +5 DO PRESSKEY^BLRGMENU(9)
- End DoDot:1
- QUIT
- +6 ;
- +7 KILL ^XTMP("BLRRLTDI")
- +8 ;
- +9 SET ^XTMP("BLRRLTDI",0)=DT_"^"_$$HTFM^XLFDT(+$HOROLOG+30)_"^Reference Lab Test Delete Errors"
- +10 ;
- +11 ; Set the Error Messages
- +12 SET ERRMAX=1
- SET ERRMSG(ERRMAX)="Not authorized to change test status."
- +13 SET ERRMAX=ERRMAX+1
- SET ERRMSG(ERRMAX)="Accession has no Test."
- +14 SET ERRMAX=ERRMAX+1
- SET ERRMSG(ERRMAX)="Someone else is working on this accession"
- +15 SET ERRMAX=ERRMAX+1
- SET ERRMSG(ERRMAX)="Someone else is working on this data."
- +16 SET ERRMAX=ERRMAX+1
- SET ERRMSG(ERRMAX)="Can't find Lab Data for this accession"
- +17 SET ERRMAX=ERRMAX+1
- SET ERRMSG(ERRMAX)="There is no Order for this Accession"
- +18 SET ERRMAX=ERRMAX+1
- SET ERRMSG(ERRMAX)="No Subscript for this Accession Area"
- +19 ;
- +20 ; Set the ^XTMP Array
- +21 SET CNT=0
- SET ERR=1
- +22 FOR
- IF CNT>99
- QUIT
- Begin DoDot:1
- +23 FOR
- SET UID=$TRANSLATE($JUSTIFY($RANDOM(10000000000),10)," ","0")
- IF $DATA(^XTMP("BLRRLTDI","UID",UID))<1
- QUIT
- +24 SET ^XTMP("BLRRLTDI","UID")=1+$GET(^XTMP("BLRRLTDI","UID"))
- +25 ;
- +26 SET FAKEDUZ=$TRANSLATE($JUSTIFY($RANDOM(10000),5)," ","0")
- +27 SET FAKERTN=$SELECT((CNT#2):"BLRRLTDR",1:"BLRRLTAR")
- +28 SET ^XTMP("BLRRLTDI","UID",UID,"DUZ",FAKEDUZ,$HOROLOG)=ERRMSG(ERR)_"^"_FAKERTN
- SET ERR=ERR+1
- IF ERR>ERRMAX
- SET ERR=1
- +29 SET CNT=CNT+1
- End DoDot:1
- +30 ;
- +31 DO XTMPIRPT
- +32 ;
- +33 QUIT
- +34 ;
- DEBUG ; EP - Debug BLRRLTDR
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3 KILL ^XTMP("BLRTRACE")
- +4 IF $PIECE($GET(LRPARAM),"^",3)=""
- DO ^LRPARAM
- +5 ;
- +6 DO ^XBFMK
- +7 SET DIR(0)="NO"
- +8 SET DIR("A")="Enter 62.49 Message Number"
- +9 DO ^DIR
- +10 IF +$GET(DIRUT)
- Begin DoDot:1
- +11 WRITE !!,?4,"No/Invalid Entry. Routine Ends."
- +12 DO PRESSKEY^BLRGMENU(9)
- End DoDot:1
- QUIT
- +13 ;
- +14 SET LA76249=+$GET(X)
- +15 DO PEP^BLRRLTDR
- +16 QUIT
- +17 ;
- REPORTS ; EP - Reports Menu
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
- +4 ;
- +5 DO ADDTMENU^BLRGMENU("TXNSREPT^BLRRLTDU","Successful Updates")
- +6 DO ADDTMENU^BLRGMENU("XTMPNRPT^BLRRLTDU","'Not Performed' Success")
- +7 DO ADDTMENU^BLRGMENU("TXNSURPT^BLRRLTDU","NON Successful updates")
- +8 ;
- +9 ; Main Menu driver
- +10 DO MENUDRVR^BLRGMENU("RPMS Reference Lab ","Automatic Updating Reports")
- +11 QUIT