INTSTRT1.m

INTSTRT1 ;JD; 26 Mar 97 13:44; 

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

 Q

QUERY(INDA,DIPA,INEXPAND) ;Do Query response messages

 ;Input:

 ; INDA - ien of 4001.1

 ; DIPA - Store needed variables

 ; INEXPAND - 0 Don't expand output, 1 expand output

 N INBPNSR,INBPNAP,INIPADDR,INIPPO

 ;get messages from saved message list

 D UPDTSND^INTSUT3(INDA)

 ;Outbound message and nothing was selected to send

 I '$D(^UTILITY("INTHU",DUZ,$J)) D DISPLAY^INTSUT1("Note - messages have not been selected transmit")

 D ENAUTO^INTS(INDA,.DIPA,INEXPAND)

 Q

UNSOLI(INDIR,DIPA,INEXPAND,INDA,DIE) ;Process unsolicted message

 ;Input:

 ; INDIR - I Inbound, O Outbound

 ; DIPA - Store needed variables

 ; INEXPAND - 0 Don't expand output, 1 expand output

 ; INDA - ien of 4001.1

 ; DIE - 4001.1

 N INRTN

 I INDIR="I" S INRTN="EN^INTSREC(INEXPAND,INDA,DIE)"

 I INDIR="O" S INRTN="EN^INTSEND(INEXPAND,INDA,DIE)"

 D ZIS^INHUT8(INRTN,"INEXPAND^INDA^DIE^",1,"","",INDEV)

 D LISTMSG(INDA)

 ;If came up as server halt to reset TCP/IP socket

 I $$VAL^DWRA(4001.1,13.03,2,"^DIZ(4001.1,",INDA) D HALT

 Q

UNIT(INDA,INDIR,INEXPAND) ;Unit test functions

 ;Input:

 ; INDA - ien of Criteria

 ; INDIR - I Inbound, O Outbound

 ; INEXPAND - 0 Don't expand output, 1 expand output

 N INSPROC,INTSK,INHF,INPRE,INPOST

 S INSPROC=$$VAL^DWRA(4001.1,13.07,2,DIE,INDA)

 S INIP("PRE")=$$VAL^DWRA(4001.1,21.01,2,DIE,INDA)

 S INIP("POST")=$$VAL^DWRA(4001.1,22.01,2,DIE,INDA)

 S INIP("DIR")=INDIR,INIP("SPROC")=INSPROC

 ;Start of process=Format does not have UIF messages, others do

 ;;I INSPROC'="F",'$D(INREQLST) D DISPLAY^INTSUT1("No messages selected") Q

 ;;Move into INTSTO--I INSPROC'="F",'$D(^UTILITY("INTHU",DUZ,$J)) D DISPLAY^INTSUT1("Note - no messages selected") Q

 ;;move into INTSTF---I INPRE'="" X INPRE S:$G(INHF) INTSK=INHF

 ;If start of process=Format, PREprocess code must return INHF>0

 ;;I INSPROC="F",$G(INHF)<1 D DISPLAY^INTSUT1("No formatter entry exists") Q

 ;Identify the routine for the entry process

 S INROU=$S(INSPROC="F":"EN^INTSTF(.INIP,INEXPAND,INDA)",INSPROC="O":"EN^INTSTO(.INIP,INEXPAND,INDA)",INSPROC="R":"EN^INTSTO(.INIP,INEXPAND,INDA)",1:"Q")

 I INROU="Q" D DISPLAY^INTSUT1("No support for this function") Q

 D ZIS^INHUT8(INROU,"INTSK^INREQLST(^INIP(",1,"","",INDEV)

 D LISTMSG(INDA)

 Q

LISTMSG(INDA) ;List Messages using listman

 ;Input:

 ; INDA - ien of 4001.1

 ; ^UTILITY("DIS",$J) - Global with messages in it

 ;

 N DWL,DWLRF,DWLB

 S DWLB="0^4^16^78"

 S DWL("TITLE")="D LSTHDR^INTSTRT("_INDA_")"

 S DWLRF="^UTILITY(""DIS"",$J)",DWL="XWFE'",DWLB="0^4^16^78"

 F  D ^DWL Q:DWLR'="E"  D DISPEXP^INTSUT1(.DWLRF),LSTHDR^INTSTRT(INDA)

 ;D:$D(DWLMK)>1 DISPEXP^INTSUT1(.DWLMK),CLR^DIJF,SCR^INTSUT1(5,17,1),LSTHDR^INTSTRT(INDA)

 K ^UTILITY("DIS",$J)

 Q

CRDUZ ;Stuff current user DUZ into file

 N INOIEN

 S INOIEN=$O(^UTILITY("INHSYS",$J,4001.1,""))

 I INOIEN D

 .;set user field to current user

 .S $P(^UTILITY("INHSYS",$J,4001.1,INOIEN,0),U,2)=$P(^DIC(3,DUZ,0),U)

 Q

CONTINUE(INODE0) ;Continue with restore or stop

 ;Input:

 ; INODE0 - 0 node of flat file or 4001.1 file

 Q:'$$EXISTS^INTSUT3(INODE0,.INAME) 1

 Q $$YN^UTWRD("Overwrite "_INAME_" with new version? ;0")

 ;

HALT ;Halt if process was a server

 ;D CLR^DIJF

 ;W !,"Process was a Server. Halting to close socket"

 ;D HALT^ZU

 Q

UNLOCK(INDA,INOPT) ;unlock all but one lock of INDA

 ;Input:

 ; INDA - ien of lock to keep locked

 ; INOPT - array with lock count

 ;

 N INA,%

 S INA="" F  S INA=$O(INOPT("LOCK",INA)) Q:'INA  D

 .;unlock all non INDA locks

 .I INA'=INDA D

 ..F I=+INOPT("LOCK",INA):-1:1 S %=$$LOCK^INHUTC(INA,0)

 ..K INOPT("LOCK",INA)

 .;if same as INDA unlock all but one lock

 .I INA=INDA D

 ..F I=+INOPT("LOCK",INA):-1:2 S %=$$LOCK^INHUTC(INA,0)

 ..S INOPT("LOCK",INA)=1

 Q

INTSTRT1  ;JD; 26 Mar 97 13:44; 

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

 +4        QUIT 

QUERY(INDA,DIPA,INEXPAND) ;Do Query response messages

 +1       ;Input:

 +2       ; INDA - ien of 4001.1

 +3       ; DIPA - Store needed variables

 +4       ; INEXPAND - 0 Don't expand output, 1 expand output

 +5        NEW INBPNSR,INBPNAP,INIPADDR,INIPPO

 +6       ;get messages from saved message list

 +7        DO UPDTSND^INTSUT3(INDA)

 +8       ;Outbound message and nothing was selected to send

 +9        IF '$DATA(^UTILITY("INTHU",DUZ,$JOB))

               DO DISPLAY^INTSUT1("Note - messages have not been selected transmit")

 +10       DO ENAUTO^INTS(INDA,.DIPA,INEXPAND)

 +11       QUIT 

UNSOLI(INDIR,DIPA,INEXPAND,INDA,DIE) ;Process unsolicted message

 +1       ;Input:

 +2       ; INDIR - I Inbound, O Outbound

 +3       ; DIPA - Store needed variables

 +4       ; INEXPAND - 0 Don't expand output, 1 expand output

 +5       ; INDA - ien of 4001.1

 +6       ; DIE - 4001.1

 +7        NEW INRTN

 +8        IF INDIR="I"

               SET INRTN="EN^INTSREC(INEXPAND,INDA,DIE)"

 +9        IF INDIR="O"

               SET INRTN="EN^INTSEND(INEXPAND,INDA,DIE)"

 +10       DO ZIS^INHUT8(INRTN,"INEXPAND^INDA^DIE^",1,"","",INDEV)

 +11       DO LISTMSG(INDA)

 +12      ;If came up as server halt to reset TCP/IP socket

 +13       IF $$VAL^DWRA(4001.1,13.03,2,"^DIZ(4001.1,",INDA)

               DO HALT

 +14       QUIT 

UNIT(INDA,INDIR,INEXPAND) ;Unit test functions

 +1       ;Input:

 +2       ; INDA - ien of Criteria

 +3       ; INDIR - I Inbound, O Outbound

 +4       ; INEXPAND - 0 Don't expand output, 1 expand output

 +5        NEW INSPROC,INTSK,INHF,INPRE,INPOST

 +6        SET INSPROC=$$VAL^DWRA(4001.1,13.07,2,DIE,INDA)

 +7        SET INIP("PRE")=$$VAL^DWRA(4001.1,21.01,2,DIE,INDA)

 +8        SET INIP("POST")=$$VAL^DWRA(4001.1,22.01,2,DIE,INDA)

 +9        SET INIP("DIR")=INDIR

           SET INIP("SPROC")=INSPROC

 +10      ;Start of process=Format does not have UIF messages, others do

 +11      ;;I INSPROC'="F",'$D(INREQLST) D DISPLAY^INTSUT1("No messages selected") Q

 +12      ;;Move into INTSTO--I INSPROC'="F",'$D(^UTILITY("INTHU",DUZ,$J)) D DISPLAY^INTSUT1("Note - no messages selected") Q

 +13      ;;move into INTSTF---I INPRE'="" X INPRE S:$G(INHF) INTSK=INHF

 +14      ;If start of process=Format, PREprocess code must return INHF>0

 +15      ;;I INSPROC="F",$G(INHF)<1 D DISPLAY^INTSUT1("No formatter entry exists") Q

 +16      ;Identify the routine for the entry process

 +17       SET INROU=$SELECT(INSPROC="F":"EN^INTSTF(.INIP,INEXPAND,INDA)",INSPROC="O":"EN^INTSTO(.INIP,INEXPAND,INDA)",INSPROC="R":"EN^INTSTO(.INIP,INEXPAND,INDA)",1:"Q")

 +18       IF INROU="Q"

               DO DISPLAY^INTSUT1("No support for this function")

               QUIT 

 +19       DO ZIS^INHUT8(INROU,"INTSK^INREQLST(^INIP(",1,"","",INDEV)

 +20       DO LISTMSG(INDA)

 +21       QUIT 

LISTMSG(INDA) ;List Messages using listman

 +1       ;Input:

 +2       ; INDA - ien of 4001.1

 +3       ; ^UTILITY("DIS",$J) - Global with messages in it

 +4       ;

 +5        NEW DWL,DWLRF,DWLB

 +6        SET DWLB="0^4^16^78"

 +7        SET DWL("TITLE")="D LSTHDR^INTSTRT("_INDA_")"

 +8        SET DWLRF="^UTILITY(""DIS"",$J)"

           SET DWL="XWFE'"

           SET DWLB="0^4^16^78"

 +9        FOR 

               DO ^DWL

               IF DWLR'="E"

                   QUIT 

               DO DISPEXP^INTSUT1(.DWLRF)

               DO LSTHDR^INTSTRT(INDA)

 +10      ;D:$D(DWLMK)>1 DISPEXP^INTSUT1(.DWLMK),CLR^DIJF,SCR^INTSUT1(5,17,1),LSTHDR^INTSTRT(INDA)

 +11       KILL ^UTILITY("DIS",$JOB)

 +12       QUIT 

CRDUZ     ;Stuff current user DUZ into file

 +1        NEW INOIEN

 +2        SET INOIEN=$ORDER(^UTILITY("INHSYS",$JOB,4001.1,""))

 +3        IF INOIEN

               Begin DoDot:1

 +4       ;set user field to current user

 +5                SET $PIECE(^UTILITY("INHSYS",$JOB,4001.1,INOIEN,0),U,2)=$PIECE(^DIC(3,DUZ,0),U)

               End DoDot:1

 +6        QUIT 

CONTINUE(INODE0) ;Continue with restore or stop

 +1       ;Input:

 +2       ; INODE0 - 0 node of flat file or 4001.1 file

 +3        IF '$$EXISTS^INTSUT3(INODE0,.INAME)

               QUIT 1

 +4        QUIT $$YN^UTWRD("Overwrite "_INAME_" with new version? ;0")

 +5       ;

HALT      ;Halt if process was a server

 +1       ;D CLR^DIJF

 +2       ;W !,"Process was a Server. Halting to close socket"

 +3       ;D HALT^ZU

 +4        QUIT 

UNLOCK(INDA,INOPT) ;unlock all but one lock of INDA

 +1       ;Input:

 +2       ; INDA - ien of lock to keep locked

 +3       ; INOPT - array with lock count

 +4       ;

 +5        NEW INA,%

 +6        SET INA=""

           FOR 

               SET INA=$ORDER(INOPT("LOCK",INA))

               IF 'INA

                   QUIT 

               Begin DoDot:1

 +7       ;unlock all non INDA locks

 +8                IF INA'=INDA

                       Begin DoDot:2

 +9                        FOR I=+INOPT("LOCK",INA):-1:1

                               SET %=$$LOCK^INHUTC(INA,0)

 +10                       KILL INOPT("LOCK",INA)

                       End DoDot:2

 +11      ;if same as INDA unlock all but one lock

 +12               IF INA=INDA

                       Begin DoDot:2

 +13                       FOR I=+INOPT("LOCK",INA):-1:2

                               SET %=$$LOCK^INHUTC(INA,0)

 +14                       SET INOPT("LOCK",INA)=1

                       End DoDot:2

               End DoDot:1

 +15       QUIT