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

IVMLSU3.m

Go to the documentation of this file. 
  1. IVMLSU3 ;ALB/MLI/KCL - IVM Functions from List Manager Application ; 7 Jan 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. SSNUP ; - upload selected SSNs, reset data in array/file
  1.  N X
  1.  I 'IVMVSSN!(IVMUP'["V") G SPOUSE
  1.  S X=$O(^DPT("SSN",IVMVSSN,0)),X=$$PT^IVMUFNC4(+X)
  1.  I X]"" W !!,*7,"Social Security Number: "_$P(X,"^",2)_" is currently on file!" W !,"This SSN is in use by patient: ",$P(X,"^",1) D PAUSE^VALM1 G SPOUSE
  1.  S DA=DFN,DIE="^DPT(",DR=".09///^S X=IVMVSSN" D ^DIE
  1.  W !!?3,"...patient Social Security Number (SSN) has been updated.",!
  1.  S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
  1.  ;
  1.  ; - delete ssa/ssn for patient in the list man array
  1.  S $P(^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ),"^",6)=""
  1.  ;
  1.  ;
  1. SPOUSE ; - spouse ssn update (falls through)
  1.  ;
  1.  I 'IVMSIEN!(IVMUP'["S") G SSNUPQ
  1.  S X=$P($G(^DGPR(408.12,IVMSIEN,0)),"^",3)
  1.  S DA=+X,DIE="^"_$P(X,";",2),DR=".09///"_IVMSSSN D ^DIE
  1.  W !!?3,"...spouse's Social Security Number (SSN) has been updated.",!
  1.  S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
  1.  ;
  1.  ; - delete spouse fields from list man array
  1.  S $P(^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ),"^",7)="",$P(^(IVMJ),"^",8)="",$P(^(IVMJ),"^",9)=""
  1.  ;
  1.  ;
  1. SSNUPQ ; - if no ssa/ssn for the patient and spouse - delete entry from list
  1.  S X=^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)
  1.  I '$P(X,"^",6),'$P(X,"^",9) D DELENT
  1.  K DA,DIE,DR,Y
  1.  Q
  1.  ;
  1.  ;
  1. DELENT ; - once entry is purged or uploaded - delete entry from (#301.5)
  1.  ;   file and delete from list man array
  1.  ;
  1.  ;  Input:  IVMND  --  as pt name^pt ssn^dfn^sp ien^date of death^da(1)^da
  1.  ;
  1.  N X,Y
  1.  K ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)
  1.  S DA(1)=IVMI,DA=IVMJ,DIK="^IVM(301.5,"_DA(1)_",""IN"","
  1.  D ^DIK
  1.  K DA,DIC,DIK
  1.  Q
  1.  ;
  1.  ;
  1. RUSURE ; - Are you sure about UP-upload or PU-purge actions?
  1.  ;
  1.  ;  Input - IVMWHERE = "PU" if from purge, "UP" if from update
  1.  ; Output - IVMOUT = 1 for '^', 2 for time-out, 0 otherwise
  1.  ;          IVMSURE = 1 for yes, 0 for no
  1.  ;
  1.  N X,Y
  1.  ;
  1.  ; - set screen to full scrolling region
  1.  D FULL^VALM1
  1.  W !
  1.  S IVMACT=$S(IVMWHERE="PU":"purge",1:"update")
  1.  S DIR("A")="Are you sure you want to "_IVMACT_" this entry",DIR(0)="Y"
  1.  ;
  1.  ; - purge help
  1.  I IVMACT="purge" D
  1.  .S DIR("?",1)="Entering 'YES' at this prompt will cause the entire entry to"
  1.  .S DIR("?",2)="be removed from the list.  Purging an entry will delete the"
  1.  .S DIR("?",3)="SSA/SSN's that have been received from the IVM Center, for"
  1.  .S DIR("?",4)="both the patient and his or her spouse."
  1.  .S DIR("?",5)=" "
  1.  .S DIR("?",6)="Entering 'NO' at this prompt will cause the entry to remain on"
  1.  .S DIR("?",7)="the list.  The entry will remain on the list until either an"
  1.  .S DIR("?")="'UPDATE' or 'PURGE' action has been taken"
  1.  ;
  1.  ; - update help
  1.  I IVMACT="update" D
  1.  .S DIR("?",1)="Entering 'YES' will update the SSN for "_$S(IVMUP="S":"the spouse.",IVMUP="VS":"both the patient and the spouse.",1:"the patient.")
  1.  .S DIR("?",2)=" "
  1.  .S DIR("?",3)="Entering 'NO' will cause the SSN for "_$S(IVMUP="S":"the spouse.",IVMUP="VS":"both the patient and the spouse.",1:"the patient.")
  1.  .S DIR("?",4)="to remain on the list."
  1.  .S DIR("?",5)=" "
  1.  .S DIR("?",6)="Once an SSN has been updated, the entry will be removed from the"
  1.  .S DIR("?",7)="list and the patient record will be updated with the SSA/SSN that"
  1.  .S DIR("?")="was received from the IVM Center."
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  S IVMSURE=$G(Y)
  1.  S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)
  1.  K DIR,DIROUT,DTOUT,DUOUT,IVMACT
  1.  Q