- 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 Feb 18, 2025@23:27:29 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