GECSSGET ;WISC/RFJ/KLD-get data from stack file ;13 Oct 98
;;2.0;GCS;**19,28**;MAR 14, 1995
Q
;
;
DATA(DOCID,CODESHET) ; return data from stack file for docid (.01 field)
; pass codeshet=1 for code sheet data also
; data will be returned in gecsdata
K GECSDATA
N %,D0,DA,DIC,DIQ,DIQ2,DR
S DOCID=$$PADSPACE(DOCID)
S DA=+$O(^GECS(2100.1,"B",DOCID,0)) Q:'DA
S DIC="^GECS(2100.1,",DR=".01:26",DIQ="GECSDATA",DIQ(0)="E"
I '$G(CODESHET) S DR=".01:7;11:26"
S GECSDATA=DA
D EN^DIQ1
Q
;
;
STATUS(DOCID) ; return status of docid (.01 field)
; return -1 if entry not found
N %,DA,STATUS
S DOCID=$$PADSPACE(DOCID)
S DA=+$O(^GECS(2100.1,"B",DOCID,0)) I 'DA Q -1
S STATUS=$P($G(^GECS(2100.1,DA,0)),"^",4)
Q $P($P($P(^DD(2100.1,3,0),"^",3),STATUS_":",2),";")
;
;
PADSPACE(DOCID) ; return docid with padded spaces
N %
S %=$P(DOCID,"-")_$E(" ",1,2-$L($P(DOCID,"-")))_"-"_$P(DOCID,"-",2)_$E(" ",1,11-$L($P(DOCID,"-",2)))
I $P(DOCID,"-",3)'="" S %=%_"-"_$P(DOCID,"-",3)_$E(" ",1,6-$L($P(DOCID,"-",3)))
Q %
;
;
KEYLOOK(GECSKEY,CODESHET) ; lookup and return document data based on a lookup key
; codeshet passed to data to return the document code sheet data
N GECSDA,GECSDOC
I $L(GECSKEY)="" Q
; find the document ien based on input key
S GECSDA=$O(^GECS(2100.1,"KEY",GECSKEY,0))
I 'GECSDA Q
; find the document identifier (.01 field)
S GECSDOC=$P($G(^GECS(2100.1,GECSDA,0)),"^")
I GECSDOC="" Q
; get the data
D DATA(GECSDOC,CODESHET)
Q
;
;
GETID(IEN) ; return .01 field of file #2100.1
;
N ID
S ID=$$GET1^DIQ(2100.1,IEN,.01)
Q ID
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSSGET 1667 printed Oct 16, 2024@17:57:13 Page 2
GECSSGET ;WISC/RFJ/KLD-get data from stack file ;13 Oct 98
+1 ;;2.0;GCS;**19,28**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
DATA(DOCID,CODESHET) ; return data from stack file for docid (.01 field)
+1 ; pass codeshet=1 for code sheet data also
+2 ; data will be returned in gecsdata
+3 KILL GECSDATA
+4 NEW %,D0,DA,DIC,DIQ,DIQ2,DR
+5 SET DOCID=$$PADSPACE(DOCID)
+6 SET DA=+$ORDER(^GECS(2100.1,"B",DOCID,0))
if 'DA
QUIT
+7 SET DIC="^GECS(2100.1,"
SET DR=".01:26"
SET DIQ="GECSDATA"
SET DIQ(0)="E"
+8 IF '$GET(CODESHET)
SET DR=".01:7;11:26"
+9 SET GECSDATA=DA
+10 DO EN^DIQ1
+11 QUIT
+12 ;
+13 ;
STATUS(DOCID) ; return status of docid (.01 field)
+1 ; return -1 if entry not found
+2 NEW %,DA,STATUS
+3 SET DOCID=$$PADSPACE(DOCID)
+4 SET DA=+$ORDER(^GECS(2100.1,"B",DOCID,0))
IF 'DA
QUIT -1
+5 SET STATUS=$PIECE($GET(^GECS(2100.1,DA,0)),"^",4)
+6 QUIT $PIECE($PIECE($PIECE(^DD(2100.1,3,0),"^",3),STATUS_":",2),";")
+7 ;
+8 ;
PADSPACE(DOCID) ; return docid with padded spaces
+1 NEW %
+2 SET %=$PIECE(DOCID,"-")_$EXTRACT(" ",1,2-$LENGTH($PIECE(DOCID,"-")))_"-"_$PIECE(DOCID,"-",2)_$EXTRACT(" ",1,11-$LENGTH($PIECE(DOCID,"-",2)))
+3 IF $PIECE(DOCID,"-",3)'=""
SET %=%_"-"_$PIECE(DOCID,"-",3)_$EXTRACT(" ",1,6-$LENGTH($PIECE(DOCID,"-",3)))
+4 QUIT %
+5 ;
+6 ;
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
+2 NEW GECSDA,GECSDOC
+3 IF $LENGTH(GECSKEY)=""
QUIT
+4 ; find the document ien based on input key
+5 SET GECSDA=$ORDER(^GECS(2100.1,"KEY",GECSKEY,0))
+6 IF 'GECSDA
QUIT
+7 ; find the document identifier (.01 field)
+8 SET GECSDOC=$PIECE($GET(^GECS(2100.1,GECSDA,0)),"^")
+9 IF GECSDOC=""
QUIT
+10 ; get the data
+11 DO DATA(GECSDOC,CODESHET)
+12 QUIT
+13 ;
+14 ;
GETID(IEN) ; return .01 field of file #2100.1
+1 ;
+2 NEW ID
+3 SET ID=$$GET1^DIQ(2100.1,IEN,.01)
+4 QUIT ID
