Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHUTC52

INHUTC52.m

Go to the documentation of this file.
  1. INHUTC52 ;DGH Search using VA list manager
  1. ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1. ;COPYRIGHT 1991-2000 SAIC
  1. ;
  1. ;
  1. ;
  1. EN(INSRCH) ; -- option entry point
  1. K XQORS,VALMEVL
  1. ;If the array exists, call the protocol that allows selection
  1. I INSRCH("TYPE")="TRANSACTION",$G(INOPT("ARRAY"))["INREQLST" D EN^VALM("INH TRANSACTION SELECT") Q
  1. I INSRCH("TYPE")="TRANSACTION" D EN^VALM("INH TRANSACTION SEARCH") Q
  1. I INSRCH("TYPE")="ERROR" D EN^VALM("INH ERROR SEARCH")
  1. Q
  1. ;
  1. ;
  1. FIND ;Entry point called from within VA List Manager
  1. ;Stack VALM variables, then call existing GIS search point.
  1. N VALMX,VALMCNTI
  1. S (VALMCNT,VALMCNTI)=0
  1. D CLEAN^VALM10
  1. D FIND^INHUTC5(.INQUIT,.INOPT,"",.INSRCH)
  1. Q
  1. ;
  1. SETTMP(INIEN,INSRCH) ;Set ^TMP global for records that match selection crit.
  1. ;called from FIND^INHUTC5
  1. ;VALM function seems to require that VALMCNT be the counter
  1. ;It is incremented in the calling routine
  1. N INDEST,INDSTNUM,INTR,INTRN,INX,INSTAT,INLOC,INWID
  1. S VALMCNT=INSRCH("INFNDCT")
  1. I INSRCH("TYPE")="TRANSACTION" D
  1. .S VALMX=^INTHU(INIEN,0)
  1. .S VALMCNTI=VALMCNTI+1
  1. .S X=$$SETFLD^VALM1(VALMCNTI,"","NUMBER")
  1. .S X=$$SETFLD^VALM1($TR($$CDATASC^%ZTFDT($P(VALMX,U),1,2),":"),X,"DATE/TIME")
  1. .S X=$$SETFLD^VALM1($P(VALMX,U,5),X,"MESSAGE ID")
  1. .S INDSTNUM=+$P(VALMX,U,2),INDEST=$S(INDSTNUM:$P($G(^INRHD(INDSTNUM,0)),U),1:""),X=$$SETFLD^VALM1(INDEST,X,"DESTINATION")
  1. .Q ;Don't do expanded display now
  1. .;patient
  1. .S INTMP=$$INMSPAT^INHMS1(INIEN,"",.INPATNAM)
  1. .S X=$$SETFLD^VALM1(INPATNAM,X,"PATIENT")
  1. .;Transaction
  1. .S INTRN=+$P(VALMX,U,11),INTR=$S(INTRN:$P($G(^INRHT(INTRN,0)),U),1:""),X=$$SETFLD^VALM1(INTR,X,"TRANSACTION")
  1. I INSRCH("TYPE")="ERROR" D
  1. .S VALMX=^INTHER(INIEN,0)
  1. .S VALMCNTI=VALMCNTI+1
  1. .S X=$$SETFLD^VALM1(VALMCNTI,"","NUMBER")
  1. .S X=$$SETFLD^VALM1($TR($$CDATASC^%ZTFDT($P(VALMX,U),1,2),":"),X,"DATE/TIME")
  1. .S INSTAT=$P(VALMX,U,10)
  1. .S INSTAT=$S($L(INSTAT):INSRCH("INETBL",+INSTAT),1:"none")
  1. .S X=$$SETFLD^VALM1(INSTAT,X,"STATUS")
  1. .S INLOC=$S(+$P(VALMX,U,5):+$P(VALMX,U,5),1:"none")
  1. .S:+INLOC INLOC=$P($G(^INTHERL(INLOC,0)),U)
  1. .S X=$$SETFLD^VALM1(INLOC,X,"LOCATION")
  1. ;Width needs to be variable if called from different screens with
  1. ;differing total widths. Set at 79 for now
  1. S INWID=77
  1. K Z S $P(Z,$E(VALMCNTI),INWID)=""
  1. D SET^VALM10(VALMCNT,$E(X_Z,1,INWID),VALMCNTI) ; set text
  1. S ^TMP("INSRCH",$J,VALMCNTI)=VALMCNT_U_INIEN
  1. D:'(VALMCNT#9) FLDCTRL^VALM10(VALMCNT) ; defaults for all fields
  1. D FLDCTRL^VALM10(VALMCNT,"NUMBER") ; default for 1 field
  1. ;D:'(VALMCNT#5) FLDCTRL^VALM10(VALMCNT,"NAME",IOUON,IOUOFF) ; adhoc
  1. D:'(VALMCNT#5) FLDCTRL^VALM10(VALMCNT,"DATE/TIME",IOUON,IOUOFF) ;adhoc
  1. D NUL:'VALMCNT
  1. Q
  1. ;
  1. HDR ; -- header
  1. ;N VALMX
  1. ;S VALMX=$G(^DIC(9.4,VALMPKG,0)),X=" Package: "_$P(VALMX,U)
  1. ;S VALMHDR(1)=$$SETSTR^VALM1("Prefix: "_$P(VALMX,U,2),X,63,15)
  1. ;S VALMHDR(2)="Description: "_$E($P(VALMX,U,3),1,65)
  1. N MSG S MSG="Interface "_$S(INSRCH("TYPE")="ERROR":"Error",1:"Transaction")_" Search"
  1. S X="",VALMHDR(1)=$$SETSTR^VALM1(MSG,X,26,29) Q
  1. ;
  1. NUL ; -- set nul message
  1. I 'VALMCNT D
  1. .F X=" "," No matching records." S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,X)
  1. .S ^TMP("INSRCH",$J,1)=1,^(2)=2
  1. Q
  1. ;
  1. FNL ; -- clean up
  1. K DIE,DIC,DR,DA,DE,DQ,VALMY,VALMPKG,^TMP("INSRCH",$J)
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. EXP ; -- expand action
  1. D FULL^VALM1
  1. N VALMI,VALMAT,VALMY
  1. D EN^VALM2(XQORNOD(0),"O") S VALMI=0
  1. F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
  1. .S VALMAT=$G(^TMP("INSRCH",$J,VALMI))
  1. .W !!,@VALMAR@(+VALMAT,0),!
  1. .I INSRCH("TYPE")="TRANSACTION" S DIC="^INTHU(",DR="0;1;3"
  1. .I INSRCH("TYPE")="ERROR" S DIC="^INTHER(",DR="0;1;2"
  1. .S DA=+$P(VALMAT,U,2) D EN^DIQ,PAUSE^VALM1
  1. S VALMBCK="R",VALMSG="'Expand' was last action picked."
  1. Q
  1. ;
  1. SEL ; Set selected item into array
  1. ;I $G(INOPT("ARRAY"))'["INREQLST" D EXP S VALMSG="'Select' was last action picked." Q
  1. N VALMI,VALMAT,VALMY,INNUM
  1. D EN^VALM2(XQORNOD(0),"O") S VALMI=0
  1. F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
  1. .S VALMAT=$G(^TMP("INSRCH",$J,VALMI))
  1. .W !!,@VALMAR@(+VALMAT,0),!
  1. .S INNUM=+VALMAT,DA=+$P(VALMAT,U,2)
  1. .;ARRAY will be set for MTC and REQUEUE functions
  1. .I $G(INOPT("ARRAY"))["INREQLST" D Q
  1. ..;CHCS listman returns array in DWLMK. GIS expects this
  1. ..S DWLMK(INNUM)=""
  1. ..;CHCS listman has @DWLRF array that must be populated.
  1. ..;It is usually INL
  1. ..S:'$D(DWLRF) DWLRF="INL"
  1. ..S @DWLRF@(INNUM)="",@DWLRF@(INNUM,0)=DA
  1. ..S VALMSG=$P($G(^INTHU(DA,0)),U,5)_" selected for processing."
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. UPD(TEXT,FLD,VALMAT) ; -- update data for screen
  1. D:VALMCC FLDCTRL^VALM10(+VALMAT,.FLD,.IOINHI,.IOINORM,1)
  1. D FLDTEXT^VALM10(+VALMAT,.FLD,.TEXT)
  1. Q
  1. ;
  1. ;