INHUTC7.m

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      ;