- 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 Jan 18, 2025@02:57:38 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