IVMLDEMU ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD UTILITIES ; 05-MAY-94
;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
;
UPLOAD(DFN,IVMPTR,IVMFIELD,IVMVALUE) ; - file demographic fields received from IVM
;
; Input: DFN -- as patient IEN
; IVMPTR -- as pointer to the FILE (#1) file.
; IVMFIELD -- as the field number to be updated
; IVMVALUE -- as the value of the field
;
; Output: None
;
N DA,DIE,DR,X
Q:'$D(DFN)!('$D(IVMPTR))!('$D(IVMFIELD))!('$D(IVMVALUE))
S DIE=$G(^DIC(IVMPTR,0,"GL")) Q:DIE']""
S DA=DFN,DR=IVMFIELD_"////^S X=IVMVALUE"
D ^DIE
Q
;
;
DELENT(IVMSUB2,IVMSUB1,IVMSUB) ; - delete entry - demographic upload data from (#301.5) sub-file
;
; Input: IVMSUB2 -- as DA(2) of (#301.511) sub-file
; IVMSUB1 -- as DA(1) of (#301.511) sub-file
; IVMSUB -- as DA of (#301.511) sub-file
;
; Output: None
;
N DA,DIK,X,Y
S DA(1)=IVMSUB1,DA(2)=IVMSUB2,DA=IVMSUB
S DIK="^IVM(301.5,"_DA(2)_",""IN"","_DA(1)_",""DEM"","
D ^DIK
Q
;
;
RUSURE(IVMFIELD,IVMACT) ; - are you sure about the action?
;
;
; Input: IVMWHERE -- "NON" for a non-uploadable field
; "UP" for a uploadable field
; IVMFIELD -- Free-text name of field to be deleted
; IVMACT -- as action taken 'update' or 'delete'
;
; Output: IVMOUT -- 1 for '^', 2 for time-out, 0 otherwise
; IVMSURE -- 1 for 'YES', 0 for 'NO'
;
; - set screen to full scrolling region
D FULL^VALM1
;
S:$G(IVMFIELD)="" IVMFIELD="<FIELD UNSPECIFIED>"
;
; - programmer supplied prompt
W ! S DIR("A")="Okay to "_IVMACT_" the "_IVMFIELD_" field",DIR(0)="Y"
;
; - set array of additional help if user enters single '?'
I IVMACT="delete" D
.S DIR("?",1)="If 'Y'es is entered at this prompt, the entry will be removed from the list."
.S DIR("?",2)="If 'N'o is entered at this prompt, the entry will remain on the list."
.S DIR("?",3)="Once an entry has been purged from the list, any upload data for that entry "
.S DIR("?")="will be deleted."
;
; - set array of additional help if user enters single '?'
I IVMACT="update" D
.S DIR("?",1)="If 'Y'es is entered at this prompt, the field will be updated and"
.S DIR("?",2)="the entry will be removed from the list."
.S DIR("?",3)=" "
.S DIR("?",4)="If 'N'o is entered at this prompt, the entry will remain on the list."
.S DIR("?",5)=""
.S DIR("?",6)="An entry will remain on the list untill an 'UF' - Upload Field action or a"
.S DIR("?")="'DF' - Delete Field action has been completed."
;
; - set default='YES'
S DIR("B")="YES"
D ^DIR
S IVMSURE=$G(Y)
S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)
;
; - refresh the screen and reset the scrolling region
S VALMBCK="R"
;
K DIR,DIROUT,DTOUT,DUOUT,Y
Q
;
RESET ; Reset IVMENT4 before returning to routine IVMLDEM4.
; Input: IVMENT4
; VALMY array
; Output: A re-set value of IVMENT4
N IND,X
S X=IVMENT4 F S X=$O(VALMY(X)) Q:'X S IND=$$ADDR(X) Q:'IND S IVMENT4=X
Q
;
ADDR(X) ; Is the corresponding field an address?
; Input: X -- VALMY subscript which is an array index
; Output: 1 -- Yes
; 0 -- No
N PTR,Y
S Y=$G(^TMP("IVMUPLOAD",$J,"IDX",X,X))
S PTR=+$O(^IVM(301.92,"B",$P(Y,"^",8),0))
Q $D(^IVM(301.92,"AD",PTR))>0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEMU 3481 printed Dec 13, 2024@02:01:54 Page 2
IVMLDEMU ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD UTILITIES ; 05-MAY-94
+1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+5 ;
UPLOAD(DFN,IVMPTR,IVMFIELD,IVMVALUE) ; - file demographic fields received from IVM
+1 ;
+2 ; Input: DFN -- as patient IEN
+3 ; IVMPTR -- as pointer to the FILE (#1) file.
+4 ; IVMFIELD -- as the field number to be updated
+5 ; IVMVALUE -- as the value of the field
+6 ;
+7 ; Output: None
+8 ;
+9 NEW DA,DIE,DR,X
+10 if '$DATA(DFN)!('$DATA(IVMPTR))!('$DATA(IVMFIELD))!('$DATA(IVMVALUE))
QUIT
+11 SET DIE=$GET(^DIC(IVMPTR,0,"GL"))
if DIE']""
QUIT
+12 SET DA=DFN
SET DR=IVMFIELD_"////^S X=IVMVALUE"
+13 DO ^DIE
+14 QUIT
+15 ;
+16 ;
DELENT(IVMSUB2,IVMSUB1,IVMSUB) ; - delete entry - demographic upload data from (#301.5) sub-file
+1 ;
+2 ; Input: IVMSUB2 -- as DA(2) of (#301.511) sub-file
+3 ; IVMSUB1 -- as DA(1) of (#301.511) sub-file
+4 ; IVMSUB -- as DA of (#301.511) sub-file
+5 ;
+6 ; Output: None
+7 ;
+8 NEW DA,DIK,X,Y
+9 SET DA(1)=IVMSUB1
SET DA(2)=IVMSUB2
SET DA=IVMSUB
+10 SET DIK="^IVM(301.5,"_DA(2)_",""IN"","_DA(1)_",""DEM"","
+11 DO ^DIK
+12 QUIT
+13 ;
+14 ;
RUSURE(IVMFIELD,IVMACT) ; - are you sure about the action?
+1 ;
+2 ;
+3 ; Input: IVMWHERE -- "NON" for a non-uploadable field
+4 ; "UP" for a uploadable field
+5 ; IVMFIELD -- Free-text name of field to be deleted
+6 ; IVMACT -- as action taken 'update' or 'delete'
+7 ;
+8 ; Output: IVMOUT -- 1 for '^', 2 for time-out, 0 otherwise
+9 ; IVMSURE -- 1 for 'YES', 0 for 'NO'
+10 ;
+11 ; - set screen to full scrolling region
+12 DO FULL^VALM1
+13 ;
+14 if $GET(IVMFIELD)=""
SET IVMFIELD="<FIELD UNSPECIFIED>"
+15 ;
+16 ; - programmer supplied prompt
+17 WRITE !
SET DIR("A")="Okay to "_IVMACT_" the "_IVMFIELD_" field"
SET DIR(0)="Y"
+18 ;
+19 ; - set array of additional help if user enters single '?'
+20 IF IVMACT="delete"
Begin DoDot:1
+21 SET DIR("?",1)="If 'Y'es is entered at this prompt, the entry will be removed from the list."
+22 SET DIR("?",2)="If 'N'o is entered at this prompt, the entry will remain on the list."
+23 SET DIR("?",3)="Once an entry has been purged from the list, any upload data for that entry "
+24 SET DIR("?")="will be deleted."
End DoDot:1
+25 ;
+26 ; - set array of additional help if user enters single '?'
+27 IF IVMACT="update"
Begin DoDot:1
+28 SET DIR("?",1)="If 'Y'es is entered at this prompt, the field will be updated and"
+29 SET DIR("?",2)="the entry will be removed from the list."
+30 SET DIR("?",3)=" "
+31 SET DIR("?",4)="If 'N'o is entered at this prompt, the entry will remain on the list."
+32 SET DIR("?",5)=""
+33 SET DIR("?",6)="An entry will remain on the list untill an 'UF' - Upload Field action or a"
+34 SET DIR("?")="'DF' - Delete Field action has been completed."
End DoDot:1
+35 ;
+36 ; - set default='YES'
+37 SET DIR("B")="YES"
+38 DO ^DIR
+39 SET IVMSURE=$GET(Y)
+40 SET IVMOUT=$SELECT($DATA(DTOUT):2,$DATA(DUOUT):1,$DATA(DIROUT):1,1:0)
+41 ;
+42 ; - refresh the screen and reset the scrolling region
+43 SET VALMBCK="R"
+44 ;
+45 KILL DIR,DIROUT,DTOUT,DUOUT,Y
+46 QUIT
+47 ;
RESET ; Reset IVMENT4 before returning to routine IVMLDEM4.
+1 ; Input: IVMENT4
+2 ; VALMY array
+3 ; Output: A re-set value of IVMENT4
+4 NEW IND,X
+5 SET X=IVMENT4
FOR
SET X=$ORDER(VALMY(X))
if 'X
QUIT
SET IND=$$ADDR(X)
if 'IND
QUIT
SET IVMENT4=X
+6 QUIT
+7 ;
ADDR(X) ; Is the corresponding field an address?
+1 ; Input: X -- VALMY subscript which is an array index
+2 ; Output: 1 -- Yes
+3 ; 0 -- No
+4 NEW PTR,Y
+5 SET Y=$GET(^TMP("IVMUPLOAD",$JOB,"IDX",X,X))
+6 SET PTR=+$ORDER(^IVM(301.92,"B",$PIECE(Y,"^",8),0))
+7 QUIT $DATA(^IVM(301.92,"AD",PTR))>0
