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

GECSSGET.m

Go to the documentation of this file.
  1. GECSSGET ;WISC/RFJ/KLD-get data from stack file ;13 Oct 98
  1. ;;2.0;GCS;**19,28**;MAR 14, 1995
  1. Q
  1. ;
  1. ;
  1. DATA(DOCID,CODESHET) ; return data from stack file for docid (.01 field)
  1. ; pass codeshet=1 for code sheet data also
  1. ; data will be returned in gecsdata
  1. K GECSDATA
  1. N %,D0,DA,DIC,DIQ,DIQ2,DR
  1. S DOCID=$$PADSPACE(DOCID)
  1. S DA=+$O(^GECS(2100.1,"B",DOCID,0)) Q:'DA
  1. S DIC="^GECS(2100.1,",DR=".01:26",DIQ="GECSDATA",DIQ(0)="E"
  1. I '$G(CODESHET) S DR=".01:7;11:26"
  1. S GECSDATA=DA
  1. D EN^DIQ1
  1. Q
  1. ;
  1. ;
  1. STATUS(DOCID) ; return status of docid (.01 field)
  1. ; return -1 if entry not found
  1. N %,DA,STATUS
  1. S DOCID=$$PADSPACE(DOCID)
  1. S DA=+$O(^GECS(2100.1,"B",DOCID,0)) I 'DA Q -1
  1. S STATUS=$P($G(^GECS(2100.1,DA,0)),"^",4)
  1. Q $P($P($P(^DD(2100.1,3,0),"^",3),STATUS_":",2),";")
  1. ;
  1. ;
  1. PADSPACE(DOCID) ; return docid with padded spaces
  1. N %
  1. S %=$P(DOCID,"-")_$E(" ",1,2-$L($P(DOCID,"-")))_"-"_$P(DOCID,"-",2)_$E(" ",1,11-$L($P(DOCID,"-",2)))
  1. I $P(DOCID,"-",3)'="" S %=%_"-"_$P(DOCID,"-",3)_$E(" ",1,6-$L($P(DOCID,"-",3)))
  1. Q %
  1. ;
  1. ;
  1. KEYLOOK(GECSKEY,CODESHET) ; lookup and return document data based on a lookup key
  1. ; codeshet passed to data to return the document code sheet data
  1. N GECSDA,GECSDOC
  1. I $L(GECSKEY)="" Q
  1. ; find the document ien based on input key
  1. S GECSDA=$O(^GECS(2100.1,"KEY",GECSKEY,0))
  1. I 'GECSDA Q
  1. ; find the document identifier (.01 field)
  1. S GECSDOC=$P($G(^GECS(2100.1,GECSDA,0)),"^")
  1. I GECSDOC="" Q
  1. ; get the data
  1. D DATA(GECSDOC,CODESHET)
  1. Q
  1. ;
  1. ;
  1. GETID(IEN) ; return .01 field of file #2100.1
  1. ;
  1. N ID
  1. S ID=$$GET1^DIQ(2100.1,IEN,.01)
  1. Q ID