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