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

HLOSITE.m

Go to the documentation of this file.
  1. HLOSITE ;ALB/CJM/OAK/PIJ-HL7 - API for getting site parameters ;03/26/2012
  1. ;;1.6;HEALTH LEVEL SEVEN;**126,138,147,153,158**;Oct 13, 1995;Build 14
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. SYSPARMS(SYSTEM) ;Gets system parameters from file 779.1
  1. ;Input: none
  1. ;Output: SYSTEM array (pass by reference)
  1. ;
  1. N NODE,LINK,PURGE
  1. S NODE=$G(^HLD(779.1,1,0))
  1. S SYSTEM("DOMAIN")=$P(NODE,"^")
  1. S SYSTEM("STATION")=$P(NODE,"^",2)
  1. S SYSTEM("PROCESSING ID")=$P(NODE,"^",3)
  1. S SYSTEM("MAXSTRING")=$P(NODE,"^",4)
  1. I ('SYSTEM("MAXSTRING"))!(SYSTEM("MAXSTRING")<256) D
  1. .N OS S OS=^%ZOSF("OS")
  1. .S SYSTEM("MAXSTRING")=$S(OS["OpenM":512,OS["DSM":512,1:256)
  1. S SYSTEM("HL7 BUFFER")=$P(NODE,"^",5)
  1. S:'SYSTEM("HL7 BUFFER") SYSTEM("HL7 BUFFER")=15000
  1. S SYSTEM("USER BUFFER")=$P(NODE,"^",6)
  1. S:'SYSTEM("USER BUFFER") SYSTEM("USER BUFFER")=5000
  1. S SYSTEM("NORMAL PURGE")=$P(NODE,"^",7)
  1. I 'SYSTEM("NORMAL PURGE") S SYSTEM("NORMAL PURGE")=3
  1. S SYSTEM("ERROR PURGE")=$P(NODE,"^",8)
  1. I 'SYSTEM("ERROR PURGE") S SYSTEM("ERROR PURGE")=7
  1. S LINK=$P(NODE,"^",10)
  1. S:LINK SYSTEM("PORT")=$$PORT^HLOTLNK(LINK)
  1. S:'$G(SYSTEM("PORT")) SYSTEM("PORT")=$S(SYSTEM("PROCESSING ID")="P":5001,1:5026)
  1. S SYSTEM("NODE")=$P(NODE,"^",13)
  1. I SYSTEM("NODE") S SYSTEM("NODE")=$P($G(^%ZIS(14.7,SYSTEM("NODE"),0)),"^")
  1. Q
  1. SYSPURGE(PURGE) ;returns system purge parameters
  1. ;Output: PURGE (pass by reference)
  1. ;
  1. N NODE
  1. S NODE=$G(^HLD(779.1,1,0))
  1. S PURGE("NORMAL")=$P(NODE,"^",7)
  1. I 'PURGE("NORMAL") S PURGE("NORMAL")=3
  1. S PURGE("ERROR")=$P(NODE,"^",8)
  1. I 'PURGE("ERROR") S PURGE("ERROR")=7
  1. Q
  1. ;
  1. GETNODE() ;
  1. N NODE
  1. S NODE=$P($G(^HLD(779.1,1,0)),"^",13)
  1. Q:NODE $P($G(^%ZIS(14.7,NODE,0)),"^")
  1. Q ""
  1. ;
  1. INC(VARIABLE,AMOUNT) ;
  1. ;Increments VARIABLE by AMOUNT, using $I if available, otherwise by locking.
  1. ;
  1. N OS
  1. ;if HLCSTATE has been defined, then we have already checked the OS, so use it.
  1. I $D(HLCSTATE("SYSTEM","OS")) D
  1. .S OS=HLCSTATE("SYSTEM","OS")
  1. E D
  1. .S OS=^%ZOSF("OS")
  1. I '$G(AMOUNT) S AMOUNT=1
  1. I (OS["OpenM")!(OS["DSM")!(OS["CACHE") Q $I(@VARIABLE,AMOUNT)
  1. L +VARIABLE:100
  1. S @VARIABLE=@VARIABLE+AMOUNT
  1. L -VARIABLE
  1. Q @VARIABLE
  1. ;
  1. COUNT778() ;
  1. ;This function returns the # of records in file 778.
  1. N COUNT,IEN
  1. S (COUNT,IEN)=0
  1. F S IEN=$O(^HLB(IEN)) Q:'IEN S COUNT=COUNT+1
  1. Q COUNT
  1. COUNT777() ;
  1. ;This function returns the # of records in file 777.
  1. N COUNT,IEN
  1. S (COUNT,IEN)=0
  1. F S IEN=$O(^HLA(IEN)) Q:'IEN S COUNT=COUNT+1
  1. Q COUNT
  1. ;
  1. UPDCNTS(WORK) ;update the record counts for file 777,778
  1. N COUNT
  1. S COUNT=$$COUNT777^HLOSITE
  1. S $P(^HLA(0),"^",4)=COUNT
  1. S ^HLTMP("FILE 777 RECORD COUNT")=COUNT_"^"_$$NOW^XLFDT
  1. S COUNT=$$COUNT778^HLOSITE
  1. S $P(^HLB(0),"^",4)=COUNT
  1. S ^HLTMP("FILE 778 RECORD COUNT")=COUNT_"^"_$$NOW^XLFDT
  1. Q
  1. ;;HL*1.6*138 start PIJ 10/26/2007
  1. RCNT(ST) ;This section sets or reads the recount flag.
  1. ;; When ST="S" Flag is set
  1. ;; When ST="U" Flag is unset
  1. I $G(ST)="S" S $P(^HLD(779.1,1,0),"^",11)=1
  1. I $G(ST)="U" S $P(^HLD(779.1,1,0),"^",11)=0
  1. Q $P($G(^HLD(779.1,1,0)),"^",11)
  1. ;;HL*1.6*138 end
  1. OLDPURGE() ;returns the retention time in days for unsent messages
  1. N TIME
  1. S TIME=$P($G(^HLD(779.1,1,0)),"^",12)
  1. Q $S(TIME:TIME,1:45)