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

IVMLDEMU.m

Go to the documentation of this file.
  1. IVMLDEMU ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD UTILITIES ; 05-MAY-94
  1. ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. ;
  1. UPLOAD(DFN,IVMPTR,IVMFIELD,IVMVALUE) ; - file demographic fields received from IVM
  1. ;
  1. ; Input: DFN -- as patient IEN
  1. ; IVMPTR -- as pointer to the FILE (#1) file.
  1. ; IVMFIELD -- as the field number to be updated
  1. ; IVMVALUE -- as the value of the field
  1. ;
  1. ; Output: None
  1. ;
  1. N DA,DIE,DR,X
  1. Q:'$D(DFN)!('$D(IVMPTR))!('$D(IVMFIELD))!('$D(IVMVALUE))
  1. S DIE=$G(^DIC(IVMPTR,0,"GL")) Q:DIE']""
  1. S DA=DFN,DR=IVMFIELD_"////^S X=IVMVALUE"
  1. D ^DIE
  1. Q
  1. ;
  1. ;
  1. DELENT(IVMSUB2,IVMSUB1,IVMSUB) ; - delete entry - demographic upload data from (#301.5) sub-file
  1. ;
  1. ; Input: IVMSUB2 -- as DA(2) of (#301.511) sub-file
  1. ; IVMSUB1 -- as DA(1) of (#301.511) sub-file
  1. ; IVMSUB -- as DA of (#301.511) sub-file
  1. ;
  1. ; Output: None
  1. ;
  1. N DA,DIK,X,Y
  1. S DA(1)=IVMSUB1,DA(2)=IVMSUB2,DA=IVMSUB
  1. S DIK="^IVM(301.5,"_DA(2)_",""IN"","_DA(1)_",""DEM"","
  1. D ^DIK
  1. Q
  1. ;
  1. ;
  1. RUSURE(IVMFIELD,IVMACT) ; - are you sure about the action?
  1. ;
  1. ;
  1. ; Input: IVMWHERE -- "NON" for a non-uploadable field
  1. ; "UP" for a uploadable field
  1. ; IVMFIELD -- Free-text name of field to be deleted
  1. ; IVMACT -- as action taken 'update' or 'delete'
  1. ;
  1. ; Output: IVMOUT -- 1 for '^', 2 for time-out, 0 otherwise
  1. ; IVMSURE -- 1 for 'YES', 0 for 'NO'
  1. ;
  1. ; - set screen to full scrolling region
  1. D FULL^VALM1
  1. ;
  1. S:$G(IVMFIELD)="" IVMFIELD="<FIELD UNSPECIFIED>"
  1. ;
  1. ; - programmer supplied prompt
  1. W ! S DIR("A")="Okay to "_IVMACT_" the "_IVMFIELD_" field",DIR(0)="Y"
  1. ;
  1. ; - set array of additional help if user enters single '?'
  1. I IVMACT="delete" D
  1. .S DIR("?",1)="If 'Y'es is entered at this prompt, the entry will be removed from the list."
  1. .S DIR("?",2)="If 'N'o is entered at this prompt, the entry will remain on the list."
  1. .S DIR("?",3)="Once an entry has been purged from the list, any upload data for that entry "
  1. .S DIR("?")="will be deleted."
  1. ;
  1. ; - set array of additional help if user enters single '?'
  1. I IVMACT="update" D
  1. .S DIR("?",1)="If 'Y'es is entered at this prompt, the field will be updated and"
  1. .S DIR("?",2)="the entry will be removed from the list."
  1. .S DIR("?",3)=" "
  1. .S DIR("?",4)="If 'N'o is entered at this prompt, the entry will remain on the list."
  1. .S DIR("?",5)=""
  1. .S DIR("?",6)="An entry will remain on the list untill an 'UF' - Upload Field action or a"
  1. .S DIR("?")="'DF' - Delete Field action has been completed."
  1. ;
  1. ; - set default='YES'
  1. S DIR("B")="YES"
  1. D ^DIR
  1. S IVMSURE=$G(Y)
  1. S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)
  1. ;
  1. ; - refresh the screen and reset the scrolling region
  1. S VALMBCK="R"
  1. ;
  1. K DIR,DIROUT,DTOUT,DUOUT,Y
  1. Q
  1. ;
  1. RESET ; Reset IVMENT4 before returning to routine IVMLDEM4.
  1. ; Input: IVMENT4
  1. ; VALMY array
  1. ; Output: A re-set value of IVMENT4
  1. N IND,X
  1. S X=IVMENT4 F S X=$O(VALMY(X)) Q:'X S IND=$$ADDR(X) Q:'IND S IVMENT4=X
  1. Q
  1. ;
  1. ADDR(X) ; Is the corresponding field an address?
  1. ; Input: X -- VALMY subscript which is an array index
  1. ; Output: 1 -- Yes
  1. ; 0 -- No
  1. N PTR,Y
  1. S Y=$G(^TMP("IVMUPLOAD",$J,"IDX",X,X))
  1. S PTR=+$O(^IVM(301.92,"B",$P(Y,"^",8),0))
  1. Q $D(^IVM(301.92,"AD",PTR))>0