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

AGCNVAOB.m

Go to the documentation of this file.
  1. AGCNVAOB ;IHS/SD/EFG - CONVERT AUPNPAT FIELDS .17 AND .18 TO 7101 ;
  1. ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1. ;
  1. AOB ;FIND OLD ENTRIES IN FIELD .17 AND .18 OF AUPNPAT TO USE
  1. ;TO POPULATE NEW MULTIPLE FIELD 7101 OF AUPNPAT
  1. K AG("DFN"),AG("AOB17"),AG("AOB18")
  1. S AG("DFN")=0
  1. F S AG("DFN")=$O(^AUPNPAT(AG("DFN"))) Q:'AG("DFN") D
  1. . Q:$D(^AUPNPAT(AG("DFN"),71,0)) ;QUIT IF ALREADY DON FOR THIS PATIENT
  1. . S AG("AOB17")=$P($G(^AUPNPAT(AG("DFN"),0)),U,17) ;ASSIGN BENEFITS OBTAINED
  1. . S AG("AOB18")=$P($G(^AUPNPAT(AG("DFN"),0)),U,18) ;ASSIGN BENEFITS EXPIRED DATE
  1. . ;I +AG("AOB18")!(+AG("AOB18")) D AOBADD MR. ED'S CODE
  1. .Q:'AG("AOB17") ;MY CODE
  1. .D AOBADD
  1. K AG("DFN"),AG("AOB17"),AG("AOB18")
  1. Q
  1. AOBADD ;ADD ENTRY FROM OLD FIELDS TO NEW FIELDS
  1. K DD,DO,X,DA
  1. S DA(1)=AG("DFN")
  1. S DIC="^AUPNPAT("_DA(1)_",71,"
  1. S DIC(0)="LZE"
  1. S DLAYGO=9000001
  1. S X=AG("AOB17")
  1. K DD,DO
  1. D FILE^DICN
  1. S AG("AOBIEN")=+Y
  1. K DIC
  1. Q:AG("AOB18")=""
  1. S DIE="^AUPNPAT("_DA(1)_",71,"
  1. S DA(1)=AG("DFN")
  1. S DA=AG("AOBIEN")
  1. S DR=".02////^S X=AG(""AOB18"")"
  1. D ^DIE
  1. Q