INHUTC7 ;KN,bar; 14 Aug 97 11:33; Criteria Management and Execution API
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;;COPYRIGHT 1997 SAIC
;
; MODULE NAME: Criteria Management and Execution API (INHUTC7)
; Called from INHUTC.
;
GETCRIT(INOPT,INPARMS) ; Get/Create entries.
;
; Please refer to the function GETCRIT of INHUTC for description
;
; set defaults for vars passed in
N INCRITDA
Q:'$$TYPE^INHUTC2($G(INOPT("TYPE"))) "Incorrect or missing criteria type."
S:'$G(INOPT("DUZ")) INOPT("DUZ")=DUZ
; get entry in criteria file
S INCRITDA=$$GET^INHUTC1(.INOPT)
Q:'INCRITDA INCRITDA
; populate entry with data if passed in
I $L($G(INPARMS)),$D(@INPARMS)>9 D ARRAY^INHUTC3(INCRITDA,.INPARMS)
; update relative date fields
D RELDATE^INHUTC2(INCRITDA)
; if gallery allow edit
S:$L($G(INOPT("GALLERY"))) INCRITDA=$$EDIT^INHUTC1(INCRITDA,INOPT("GALLERY"))
I 'INCRITDA D CLRLK^INHUTC2(.INOPT) Q INCRITDA
; save entry if name field is filled in
S INCRITDA=$$SAVE^INHUTC1(.INOPT,INCRITDA,"U")
I 'INCRITDA D CLRLK^INHUTC2(.INOPT) Q
D CLRLK^INHUTC2(.INOPT,$S('INCRITDA:0,$G(INOPT("LOCK")):INCRITDA,1:""))
; set INOPT for search and print
S INOPT("CRITERIA")=INCRITDA
Q INCRITDA
;
;
RUN(INOPT,INPARMS) ; Run calling search and print
;
; Please refer to function RUN of INHUTC for description,
;
N INANS,INDEV,INOPTT,ZTSK,INIEN,INARRAY
; preserve INOPT array
M INOPTT=INOPT N INOPT M INOPT=INOPTT K INOPTT
S INPARMS=$G(INPARMS)
I '$G(INOPT("CRITERIA")) S INOPT("CRITERIA")=$$GETCRIT^INHUTC(.INOPT,.INPARMS)
Q:'INOPT("CRITERIA") INOPT("CRITERIA")
; get device, check if passed in, then check file
I $D(INOPT("DEVICE")) S (INDEV,IOP)=$D(INOPT("DEVICE"))
E S (INDEV,IOP)=$P($G(^DIZ(4001.1,INOPT("CRITERIA"),20)),U,9)
S %ZIS="NQ0" D ^%ZIS I POP S IOP="",%ZIS="N0" D ^%ZIS Q INDEV_" is an invalid device"
;
; if home device, crt, and interactive do full display search
I IO=IO(0),$E(IOST)="C",'$G(INOPT("NONINTER")) S INIEN="INARRAY" D K @INIEN Q $S(INANS:"Exit code: "_INANS,1:INOPT("CRITERIA"))
. ; Search, Display, and allow user to select
. S INANS=$$DISPLAY^INHUTC4(.INOPT,.INIEN) S:INANS'=2 INANS=0 Q:INANS
. ; return selected list in named global, if requested
. I $L($G(INOPT("ARRAY"))) M @INOPT("ARRAY")=@INIEN S INANS=4 Q
. ; Print user selected list
. I $D(@INIEN)>9 S INANS=$$PRINT(.INOPT,.INIEN)
;
; if OK TO TASK, if not SLAVE or CRT
I '$G(INOPT("NOTASK")),IO'=IO(0) D S IOP="",%ZIS="N" D ^%ZIS Q INANS
. N INDA,INBACKDA,INOPTT
. ; create background entry, unlock work entry and background entry
. S INBACKDA=$$NEW^INHUTC1(.INOPT,"B") D COPY^INHUTC1(INOPT("CRITERIA"),INBACKDA,"B") D CLRLK^INHUTC2(.INOPT)
. ; create background task
. S ZTIO=INDEV,ZTRTN="TASK^INHUTC2",ZTDESC="Interface Criteria"
. S:$G(INOPT("NONINTER")) ZTDTH=$H
. S INOPT("NOTASK")=1,INOPT("NONINTER")=1,INOPT("CRITERIA")=INBACKDA
. F I="INIEN","INOPT(" S ZTSAVE(I)=""
. D ^%ZTLOAD
. I $G(ZTSK) S $P(^DIZ(4001.1,INBACKDA,0),U,7)=ZTSK
. S INANS=$S($G(ZTSK):"criteria queued "_ZTSK,$G(POP):"device invalid",1:"error in scheduling task.")
; Non-interactive search
S INIEN="INARRAY",INANS=$$SEARCH^INHUTC(.INOPT,.INIEN)
Q:'INANS INANS
S INOPT("DEVICE")=INDEV,INANS=$$PRINT^INHUTC(.INOPT,.INIEN)
K @INIEN,INOPT("INSRCH")
Q INOPT("CRITERIA")
;
;
PRINT(INOPT,INIEN) ; Display/Print messages
;
; Please refer to the function PRINT of INHUTC for description
;
Q:'$L($G(INIEN)) "PRINT: record list not present"
N I,DIC,DR,DHD,DW,DWCP,DIE,DA,INIO,INPAGE
; Set default value for file, print template, and header
I $G(INOPT("TYPE"))="ERROR" S DIC="^INTHER(",DR="INH ERROR DISPLAY"
I $G(INOPT("TYPE"))="TRANSACTION" S DIC="^INTHU(",DR="INH MESSAGE DISPLAY"
Q:'$D(DIC) "PRINT: record type not present or invalid"
S INPAGE=0,DHD="["_DR_"-HEAD]",DIOEND="W !?(IOM-25\2),""***** End of Report *****""",DA=INIEN
; Use print template, custom header, if provided
S:$D(INOPT("PRINT")) DR=INOPT("PRINT") S:$E(DR)'="[" DR="["_DR_"]"
S:$D(INOPT("HEADER")) DHD=INOPT("HEADER") S:$E(DHD)'="[" DHD="["_DHD_"]"
; get device
S:$L($G(INOPT("DEVICE"))) IOP=INOPT("DEVICE")
I $G(INOPT("NONINTER")),'$D(IOP) S IOP=""
S %ZIS="NQ" D ^%ZIS I POP S IOP="",%ZIS="N0" D ^%ZIS Q "Device invalid or not selected."
S IOP=ION_";"_IOST_";"_IOM_";"_IOSL
D PRESORT^DWPR
Q 1
;
SRCHDR(INOPT,INPAGE) ; print cover page of criteria options
; from print template
Q:'$D(INOPT("INSRCH")) Q:'$D(INPAGE)
N X,I,INI,INF,INL,INX,INY,INZ
I 'INPAGE D
. S X=INOPT("INSRCH","TYPE"),X=$E(X)_$$DNCASE^%ZTF($E(X,2,$L(X)))
. S X="Interface "_X_" Search Report",X=$J("",IOM-$L(X)\2)_X,INOPT("INSRCH","PRNHDR",1)=X_$J("",IOM-$L(X)-9)_"Page: "
. S X="Report Date: "_$$CDATASC^%ZTFDT($$NOW^%ZTFDT,1,3)_" Run by: "_$P($G(DUZ("AG")),U,9),INOPT("INSRCH","PRNHDR",2)=$J("",IOM-$L(X)\2)_X
. S X="Records "
. S:$G(INOPT("SRCHSIZE")) X=X_"in range: "_INOPT("SRCHSIZE")_"(est) "
. S X=X_" Searched: "_+$G(INOPT("INSRCHCT"))_" Found: "_+$G(INOPT("INFNDCT"))
. S INOPT("INSRCH","PRNHDR",3)=$J("",IOM-$L(X)\2)_X
S INPAGE=INPAGE+1
F I=1:1 Q:'$D(INOPT("INSRCH","PRNHDR",I)) W:I>1 ! W INOPT("INSRCH","PRNHDR",I)_$S(I=1:INPAGE,1:"")
W !!,$TR($J("",IOM-2)," ","_")
Q:INPAGE>1
W !," Search Criteria Name",?40," Criteria Value",!
F INI=6:1 S INX=$P($T(FIELDS+INI^INHUTC3),";;",2,99) Q:'$L(INX) D
. ; quit if no INSRCH designator or not searched on
. S INY=$P(INX,";",3) Q:'$L(INY) Q:'$D(INOPT("INSRCH",INY))
. ; write field name
. W !,$P(INX,";",2),?40 S INF=$P(INX,";",4,99)
. ; write out parameters
. I $D(INOPT("INSRCH",INY))=1 S X=INOPT("INSRCH",INY) X:$L(INF) INF W X Q
. S INZ="",INL=0 F S INZ=$O(INOPT("INSRCH",INY,INZ)) Q:'$L(INZ) W:INL !?40 S X=INZ X:$L(INF) INF W X S INL=1
; skip a page and print next header, unless nothing was found
I $G(INOPT("INSRCH","INFNDCT")) D
. I IO=IO(0),$E(IOST)="C" S %=$$CR^UTSRD
. E W @IOF
. D SRCHDR(.INOPT,.INPAGE)
Q
;
INHUTC7 ;KN,bar; 14 Aug 97 11:33; Criteria Management and Execution API
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;;COPYRIGHT 1997 SAIC
+4 ;
+5 ; MODULE NAME: Criteria Management and Execution API (INHUTC7)
+6 ; Called from INHUTC.
+7 ;
GETCRIT(INOPT,INPARMS) ; Get/Create entries.
+1 ;
+2 ; Please refer to the function GETCRIT of INHUTC for description
+3 ;
+4 ; set defaults for vars passed in
+5 NEW INCRITDA
+6 IF '$$TYPE^INHUTC2($GET(INOPT("TYPE")))
QUIT "Incorrect or missing criteria type."
+7 IF '$GET(INOPT("DUZ"))
SET INOPT("DUZ")=DUZ
+8 ; get entry in criteria file
+9 SET INCRITDA=$$GET^INHUTC1(.INOPT)
+10 IF 'INCRITDA
QUIT INCRITDA
+11 ; populate entry with data if passed in
+12 IF $LENGTH($GET(INPARMS))
IF $DATA(@INPARMS)>9
DO ARRAY^INHUTC3(INCRITDA,.INPARMS)
+13 ; update relative date fields
+14 DO RELDATE^INHUTC2(INCRITDA)
+15 ; if gallery allow edit
+16 IF $LENGTH($GET(INOPT("GALLERY")))
SET INCRITDA=$$EDIT^INHUTC1(INCRITDA,INOPT("GALLERY"))
+17 IF 'INCRITDA
DO CLRLK^INHUTC2(.INOPT)
QUIT INCRITDA
+18 ; save entry if name field is filled in
+19 SET INCRITDA=$$SAVE^INHUTC1(.INOPT,INCRITDA,"U")
+20 IF 'INCRITDA
DO CLRLK^INHUTC2(.INOPT)
QUIT
+21 DO CLRLK^INHUTC2(.INOPT,$SELECT('INCRITDA:0,$GET(INOPT("LOCK")):INCRITDA,1:""))
+22 ; set INOPT for search and print
+23 SET INOPT("CRITERIA")=INCRITDA
+24 QUIT INCRITDA
+25 ;
+26 ;
RUN(INOPT,INPARMS) ; Run calling search and print
+1 ;
+2 ; Please refer to function RUN of INHUTC for description,
+3 ;
+4 NEW INANS,INDEV,INOPTT,ZTSK,INIEN,INARRAY
+5 ; preserve INOPT array
+6 MERGE INOPTT=INOPT
NEW INOPT
MERGE INOPT=INOPTT
KILL INOPTT
+7 SET INPARMS=$GET(INPARMS)
+8 IF '$GET(INOPT("CRITERIA"))
SET INOPT("CRITERIA")=$$GETCRIT^INHUTC(.INOPT,.INPARMS)
+9 IF 'INOPT("CRITERIA")
QUIT INOPT("CRITERIA")
+10 ; get device, check if passed in, then check file
+11 IF $DATA(INOPT("DEVICE"))
SET (INDEV,IOP)=$DATA(INOPT("DEVICE"))
+12 IF '$TEST
SET (INDEV,IOP)=$PIECE($GET(^DIZ(4001.1,INOPT("CRITERIA"),20)),U,9)
+13 SET %ZIS="NQ0"
DO ^%ZIS
IF POP
SET IOP=""
SET %ZIS="N0"
DO ^%ZIS
QUIT INDEV_" is an invalid device"
+14 ;
+15 ; if home device, crt, and interactive do full display search
+16 IF IO=IO(0)
IF $EXTRACT(IOST)="C"
IF '$GET(INOPT("NONINTER"))
SET INIEN="INARRAY"
Begin DoDot:1
+17 ; Search, Display, and allow user to select
+18 SET INANS=$$DISPLAY^INHUTC4(.INOPT,.INIEN)
IF INANS'=2
SET INANS=0
IF INANS
QUIT
+19 ; return selected list in named global, if requested
+20 IF $LENGTH($GET(INOPT("ARRAY")))
MERGE @INOPT("ARRAY")=@INIEN
SET INANS=4
QUIT
+21 ; Print user selected list
+22 IF $DATA(@INIEN)>9
SET INANS=$$PRINT(.INOPT,.INIEN)
End DoDot:1
KILL @INIEN
QUIT $SELECT(INANS:"Exit code: "_INANS,1:INOPT("CRITERIA"))
+23 ;
+24 ; if OK TO TASK, if not SLAVE or CRT
+25 IF '$GET(INOPT("NOTASK"))
IF IO'=IO(0)
Begin DoDot:1
+26 NEW INDA,INBACKDA,INOPTT
+27 ; create background entry, unlock work entry and background entry
+28 SET INBACKDA=$$NEW^INHUTC1(.INOPT,"B")
DO COPY^INHUTC1(INOPT("CRITERIA"),INBACKDA,"B")
DO CLRLK^INHUTC2(.INOPT)
+29 ; create background task
+30 SET ZTIO=INDEV
SET ZTRTN="TASK^INHUTC2"
SET ZTDESC="Interface Criteria"
+31 IF $GET(INOPT("NONINTER"))
SET ZTDTH=$HOROLOG
+32 SET INOPT("NOTASK")=1
SET INOPT("NONINTER")=1
SET INOPT("CRITERIA")=INBACKDA
+33 FOR I="INIEN","INOPT("
SET ZTSAVE(I)=""
+34 DO ^%ZTLOAD
+35 IF $GET(ZTSK)
SET $PIECE(^DIZ(4001.1,INBACKDA,0),U,7)=ZTSK
+36 SET INANS=$SELECT($GET(ZTSK):"criteria queued "_ZTSK,$GET(POP):"device invalid",1:"error in scheduling task.")
End DoDot:1
SET IOP=""
SET %ZIS="N"
DO ^%ZIS
QUIT INANS
+37 ; Non-interactive search
+38 SET INIEN="INARRAY"
SET INANS=$$SEARCH^INHUTC(.INOPT,.INIEN)
+39 IF 'INANS
QUIT INANS
+40 SET INOPT("DEVICE")=INDEV
SET INANS=$$PRINT^INHUTC(.INOPT,.INIEN)
+41 KILL @INIEN,INOPT("INSRCH")
+42 QUIT INOPT("CRITERIA")
+43 ;
+44 ;
PRINT(INOPT,INIEN) ; Display/Print messages
+1 ;
+2 ; Please refer to the function PRINT of INHUTC for description
+3 ;
+4 IF '$LENGTH($GET(INIEN))
QUIT "PRINT: record list not present"
+5 NEW I,DIC,DR,DHD,DW,DWCP,DIE,DA,INIO,INPAGE
+6 ; Set default value for file, print template, and header
+7 IF $GET(INOPT("TYPE"))="ERROR"
SET DIC="^INTHER("
SET DR="INH ERROR DISPLAY"
+8 IF $GET(INOPT("TYPE"))="TRANSACTION"
SET DIC="^INTHU("
SET DR="INH MESSAGE DISPLAY"
+9 IF '$DATA(DIC)
QUIT "PRINT: record type not present or invalid"
+10 SET INPAGE=0
SET DHD="["_DR_"-HEAD]"
SET DIOEND="W !?(IOM-25\2),""***** End of Report *****"""
SET DA=INIEN
+11 ; Use print template, custom header, if provided
+12 IF $DATA(INOPT("PRINT"))
SET DR=INOPT("PRINT")
IF $EXTRACT(DR)'="["
SET DR="["_DR_"]"
+13 IF $DATA(INOPT("HEADER"))
SET DHD=INOPT("HEADER")
IF $EXTRACT(DHD)'="["
SET DHD="["_DHD_"]"
+14 ; get device
+15 IF $LENGTH($GET(INOPT("DEVICE")))
SET IOP=INOPT("DEVICE")
+16 IF $GET(INOPT("NONINTER"))
IF '$DATA(IOP)
SET IOP=""
+17 SET %ZIS="NQ"
DO ^%ZIS
IF POP
SET IOP=""
SET %ZIS="N0"
DO ^%ZIS
QUIT "Device invalid or not selected."
+18 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
+19 DO PRESORT^DWPR
+20 QUIT 1
+21 ;
SRCHDR(INOPT,INPAGE) ; print cover page of criteria options
+1 ; from print template
+2 IF '$DATA(INOPT("INSRCH"))
QUIT
IF '$DATA(INPAGE)
QUIT
+3 NEW X,I,INI,INF,INL,INX,INY,INZ
+4 IF 'INPAGE
Begin DoDot:1
+5 SET X=INOPT("INSRCH","TYPE")
SET X=$EXTRACT(X)_$$DNCASE^%ZTF($EXTRACT(X,2,$LENGTH(X)))
+6 SET X="Interface "_X_" Search Report"
SET X=$JUSTIFY("",IOM-$LENGTH(X)\2)_X
SET INOPT("INSRCH","PRNHDR",1)=X_$JUSTIFY("",IOM-$LENGTH(X)-9)_"Page: "
+7 SET X="Report Date: "_$$CDATASC^%ZTFDT($$NOW^%ZTFDT,1,3)_" Run by: "_$PIECE($GET(DUZ("AG")),U,9)
SET INOPT("INSRCH","PRNHDR",2)=$JUSTIFY("",IOM-$LENGTH(X)\2)_X
+8 SET X="Records "
+9 IF $GET(INOPT("SRCHSIZE"))
SET X=X_"in range: "_INOPT("SRCHSIZE")_"(est) "
+10 SET X=X_" Searched: "_+$GET(INOPT("INSRCHCT"))_" Found: "_+$GET(INOPT("INFNDCT"))
+11 SET INOPT("INSRCH","PRNHDR",3)=$JUSTIFY("",IOM-$LENGTH(X)\2)_X
End DoDot:1
+12 SET INPAGE=INPAGE+1
+13 FOR I=1:1
IF '$DATA(INOPT("INSRCH","PRNHDR",I))
QUIT
IF I>1
WRITE !
WRITE INOPT("INSRCH","PRNHDR",I)_$SELECT(I=1:INPAGE,1:"")
+14 WRITE !!,$TRANSLATE($JUSTIFY("",IOM-2)," ","_")
+15 IF INPAGE>1
QUIT
+16 WRITE !," Search Criteria Name",?40," Criteria Value",!
+17 FOR INI=6:1
SET INX=$PIECE($TEXT(FIELDS+INI^INHUTC3),";;",2,99)
IF '$LENGTH(INX)
QUIT
Begin DoDot:1
+18 ; quit if no INSRCH designator or not searched on
+19 SET INY=$PIECE(INX,";",3)
IF '$LENGTH(INY)
QUIT
IF '$DATA(INOPT("INSRCH",INY))
QUIT
+20 ; write field name
+21 WRITE !,$PIECE(INX,";",2),?40
SET INF=$PIECE(INX,";",4,99)
+22 ; write out parameters
+23 IF $DATA(INOPT("INSRCH",INY))=1
SET X=INOPT("INSRCH",INY)
IF $LENGTH(INF)
XECUTE INF
WRITE X
QUIT
+24 SET INZ=""
SET INL=0
FOR
SET INZ=$ORDER(INOPT("INSRCH",INY,INZ))
IF '$LENGTH(INZ)
QUIT
IF INL
WRITE !?40
SET X=INZ
IF $LENGTH(INF)
XECUTE INF
WRITE X
SET INL=1
End DoDot:1
+25 ; skip a page and print next header, unless nothing was found
+26 IF $GET(INOPT("INSRCH","INFNDCT"))
Begin DoDot:1
+27 IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET %=$$CR^UTSRD
+28 IF '$TEST
WRITE @IOF
+29 DO SRCHDR(.INOPT,.INPAGE)
End DoDot:1
+30 QUIT
+31 ;
