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

LREPIAK.m

Go to the documentation of this file. 
  1. LREPIAK ;DALOI/HOAK-EXTRACT ACKNOWLEDGEMENT ;4/10/98
  1.  ;;5.2;LAB SERVICE;**175,260**;Sep 27, 1994
  1.  ;
  1.  ;
  1.  ;
  1.  ;
  1.  ;
  1.  ;
  1.  ;  ^HL(772,1732536,0) = 1700204^40^^I^^1695685^^1728022^I^4576
  1.  ;  ^HL(772,1732536,"IN",0) = ^^104^104^2980404^
  1.  ;  ^HL(772,1732536,"IN",1,0) = MSH^~|\&^NCH-AAC^200^NCH-LAB^525^19980403210341^^ACK~^1695685^P^2.2^^^NE^AL
  1.  ;                                   ID    LEVEL
  1.  ;  ^HL(772,1732536,"IN",99,0) = DSP^0001^029349629:19980401093501:000
  1.  ;  ^HL(772,1732536,"IN",101,0) = DSP^0001^010486381:19980331114855:000
  1.  ;  ^HL(772,1732536,"IN",104,0) = NNNN
  1.  ;                       CODE
  1.  ;                        \/
  1. LOOK ;  ^HL(772,1732536,"P") = 3^2980404.002435
  1.  ;
  1.  I '$G(LRPROT) S LRPROT=$G(HL("EID"))
  1.  D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLRESLTA)
  1. TEST ;
  1.  I '$G(HLFS) S HLFS=HL("FS")
  1.  S LRMID=HLMTIEN D
  1.   . D GETS^DIQ(772,LRMID,200,"Z","LREPRT","LREPMT")
  1.   . S LRMN=$P($G(LREPRT(772,LRMID_",",200,1,0)),HLFS,10)
  1.   . ;$P($G(^HL(772,LRMID,"IN",1,0)),HLFS,10)
  1.   . I '$G(LRMN) S LRMN=$P($G(HLHDR),HLFS,10)
  1.   . Q:'$G(LRMN)
  1.   . I $G(HLHDR) S LRNCHAAC=$P(HLHDR,HLFS,3)
  1.   . I '$G(LRNCHAAC) S LRNCHAAC=$P($G(LREPRT(772,LRMID_",",200,1,0)),HLFS,3)
  1.   . ;$P($G(^HL(772,LRMID,"IN",1,0)),HLFS,3)
  1.   . D GETS^DIQ(772,LRMID,20,"Z","LREPRT","LREPMT")
  1.   . S LRSTATUS=LREPRT(772,LRMID_",",20)
  1.   . ;S LRSTATUS=+$G(^HL(772,LRMID,"P"))
  1.   . I 'LRSTATUS S LRSTATUS=3
  1.   . D GETS^DIQ(772,LRMID,21,"Z","LREPRT","LREPMT")
  1.   . S LRSTADT=LREPRT(772,LRMID_",",21)
  1.   . ;S LRSTADT=$P(^HL(772,LRMID,"P"),U,2)
  1.   . S ^TMP($J,"LREPIACK",LRMN)=LRSTATUS_U_LRSTADT
  1.  I $G(LRNCHAAC)'="NCH-AAC" S HLRESLT=0 QUIT
  1.  D MAIL
  1.  S HLRESLT=0
  1.  QUIT
  1.  ;
  1.  ;
  1.  ;
  1.  ; Send a message to entries
  1.  ;
  1. MAIL I $G(DUZ)'>0 S LRDUZ2=.5
  1.  I $G(LRDUZ2)'>0 S LRDUZ2=.5
  1.  ;
  1.  ;
  1.  ;  ^XMB(3.8,"B","LR NCH-REPORT",4741)
  1.  K XMY S X="LR NCH-REPORT",XMDUZ=DUZ D INST^XMA21 I XMMG["not found" S HLRESLT="LR NCH-REPORT mail group not defined" QUIT
  1.  ;S LRGRP=$O(^XMB(3.8,"B","LR NCH-REPORT",0))
  1.  ;I '$G(LRGRP) S HLRESLT="LR NCH-REPORT mail group not defined" QUIT
  1.  ;
  1.  ;
  1.  ;  ^XMB(3.8,4741,0) = LR NCH-REPORT^PR^n^^^1^1059
  1.  ;  ^XMB(3.8,4741,1,0) = ^3.81P^2^2
  1.  ;  ^XMB(3.8,4741,1,1,0) = 10984
  1.  ;
  1.  ;  GET mail group members
  1.  ;S LRMEM=0
  1.  ;F  S LRMEM=$O(^XMB(3.8,LRGRP,1,LRMEM)) Q:+LRMEM'>0  S XMY(^(LRMEM,0))="" D
  1.  S XMDUZ=LRDUZ2
  1.  S XMTEXT="LRTXT("
  1.  S LRTXT(1)="Flash... This is an acknowledgement message from NCH"
  1.  S LRTXT(2)="Message #: "_$G(LRSTATUS)_" From the status file 771.6 message is categorized as: "
  1.  S LRX=0
  1.  F  S LRX=$O(^TMP($J,"LREPIACK",LRX)) Q:+LRX'>0  S LRSTATUS=$P(^(LRX),U),LRSTADT=$P(^(LRX),U,2) I $G(LRSTATUS) D
  1.   . S LRTXT(LRX)="Message: "_LRX_" "_$$GET1^DIQ(771.6,+LRSTATUS,.01)_" @ "_$$FMTE^XLFDT(LRSTADT)
  1.  S XMSUB="Acknowledgement message from Austin."
  1.  D ^XMD
  1.  ;
  1.  ;
  1.  QUIT
  1.  ;
  1.  ;
  1.  ;
  1. END ;
  1.  ;
  1.  K LRX,LRSTATUS,LRSTADT,LRDUZ2,LREPRT,LRMID,LRMN,LRNCHAAC,LRTXT,XMMG,XMSUB,XMTEXT
  1.  K ^TMP($J,"LREPIACK")
  1.  ;
  1.  QUIT