IBY343PR ;PRXM/KJH - Pre-Install for IB patch 343 ;29-JUN-2006
;;2.0;INTEGRATED BILLING;**343**;21-MAR-94;Build 16
;
; Sections of this code were copied from IBY320PR - which was created by ESG for IB patch 320.
;
EN ; Standard Entry Point
D CHECK
D SAVE
D DELOF
D DELPIT
Q
;
CHECK ; Check for bad provider ID type entries related to NPI
N ERROR,IEN,DA,DIK,Y
S IEN=$$FIND1^DIC(355.97,,,"NATIONAL PROVIDER ID",,,"ERROR") ; Get IEN for NPI
I IEN=35 Q ; NPI found in the correct IEN - OK to continue
I IEN="",'$D(ERROR) Q ; Entry does not exist - OK to continue
I $D(ERROR)!(IEN>29) W !,"Suspected problem with NPI entry found in file 355.97. Contact programmer for assistance." S XPDQUIT=2 Q ; May have caused other entries to be numbered improperly.
S DIK="^IBE(355.97,",DA=IEN D ^DIK ; Remove bad entry. Should be IEN=35.
Q
;
SAVE ; Save off data elements for a global node change that occurred between test versions 14 and 15.
; These will be restored to their new location during the post-install (after the DD is updated).
N IBPAR,IBIEN,DA,DIK,DIC,X,Y
D FIELD^DID(355.93,40,"","GLOBAL SUBSCRIPT LOCATION","IBPAR")
I '$D(IBPAR) Q ; First time this patch has been loaded.
I $P($G(IBPAR("GLOBAL SUBSCRIPT LOCATION")),";")="NPISTATUS" Q ; Update has already occurred.
; Save off the "NPI" nodes for each entry in file 355.93 and kill them.
K ^TMP("IBY343",$J)
S IBIEN=0
F S IBIEN=$O(^IBA(355.93,IBIEN)) Q:'IBIEN D
. M ^TMP("IBY343",$J,IBIEN,"NPI")=^IBA(355.93,IBIEN,"NPI")
. K ^IBA(355.93,IBIEN,"NPI")
. Q
; Remove the multiple from the DD
K DA,DIK,DIC
S DIK="^DD(355.93,",DA=40,DA(1)=355.93 D ^DIK
; Remove the DD entries in the multiple
K DA,DIK,DIC
S DIK="^DD(355.9301,",DA=.04,DA(1)=355.9301 D ^DIK
S DIK="^DD(355.9301,",DA=.03,DA(1)=355.9301 D ^DIK
S DIK="^DD(355.9301,",DA=.02,DA(1)=355.9301 D ^DIK
S DIK="^DD(355.9301,",DA=.01,DA(1)=355.9301 D ^DIK
; Remove the remainder of DD entries in the multiple
K ^DD(355.9301,0)
Q
;
DELPIT ; Delete included provider ID type entries
NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
S DIK="^IBE(355.97," F LN=2:1 S TAG="PIT+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" D
. F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBE(355.97,DA,0)) D ^DIK
. Q
DELPITX ;
Q
;
INCPIT(Y) ; Function to determine if provider ID type entry should be included in the build
; Y=ien to check in file 355.97
;
NEW OK,LN,TAG,DATA
S OK=0
F LN=2:1 S TAG="PIT+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" I $F(DATA,U_Y_U) S OK=1 Q
INCPITX ;
Q OK
;
DELOF ; Delete included output formatter entries
NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
F FILE=5,6,7 S DIK="^IBA(364."_FILE_"," F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" D
. F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA("364."_FILE,DA,0)) D ^DIK
. Q
DELOFX ;
Q
;
INCLUDE(FILE,Y) ; Function to determine if output formatter entry should be included in the build
; FILE=5,6,7 indicating file 364.x
; Y=ien to check
;
NEW OK,LN,TAG,DATA
S OK=0
F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" I $F(DATA,U_Y_U) S OK=1 Q
INCLUDEX ;
Q OK
;
PIT ; provider ID type entries in file 355.97 to be included
;
;;^35^
;;
;
ENT5 ; output formatter entries in file 364.5 to be included
;
;;^320^321^322^323^
;;
;
ENT6 ; output formatter entries in file 364.6 to be included
;
;;^1323^1324^1325^1326^1327^1328^1329^1330^1331^1332^1333^1334^1335^1336^1337^1338^1339^
;;
;
ENT7 ; output formatter entries in file 364.7 to be included
;
;;^1015^1041^1042^1043^1044^1045^1046^1047^1048^1049^1050^1051^1052^1053^1054^1055^1056^1057^
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY343PR 3696 printed Dec 13, 2024@02:33:44 Page 2
IBY343PR ;PRXM/KJH - Pre-Install for IB patch 343 ;29-JUN-2006
+1 ;;2.0;INTEGRATED BILLING;**343**;21-MAR-94;Build 16
+2 ;
+3 ; Sections of this code were copied from IBY320PR - which was created by ESG for IB patch 320.
+4 ;
EN ; Standard Entry Point
+1 DO CHECK
+2 DO SAVE
+3 DO DELOF
+4 DO DELPIT
+5 QUIT
+6 ;
CHECK ; Check for bad provider ID type entries related to NPI
+1 NEW ERROR,IEN,DA,DIK,Y
+2 ; Get IEN for NPI
SET IEN=$$FIND1^DIC(355.97,,,"NATIONAL PROVIDER ID",,,"ERROR")
+3 ; NPI found in the correct IEN - OK to continue
IF IEN=35
QUIT
+4 ; Entry does not exist - OK to continue
IF IEN=""
IF '$DATA(ERROR)
QUIT
+5 ; May have caused other entries to be numbered improperly.
IF $DATA(ERROR)!(IEN>29)
WRITE !,"Suspected problem with NPI entry found in file 355.97. Contact programmer for assistance."
SET XPDQUIT=2
QUIT
+6 ; Remove bad entry. Should be IEN=35.
SET DIK="^IBE(355.97,"
SET DA=IEN
DO ^DIK
+7 QUIT
+8 ;
SAVE ; Save off data elements for a global node change that occurred between test versions 14 and 15.
+1 ; These will be restored to their new location during the post-install (after the DD is updated).
+2 NEW IBPAR,IBIEN,DA,DIK,DIC,X,Y
+3 DO FIELD^DID(355.93,40,"","GLOBAL SUBSCRIPT LOCATION","IBPAR")
+4 ; First time this patch has been loaded.
IF '$DATA(IBPAR)
QUIT
+5 ; Update has already occurred.
IF $PIECE($GET(IBPAR("GLOBAL SUBSCRIPT LOCATION")),";")="NPISTATUS"
QUIT
+6 ; Save off the "NPI" nodes for each entry in file 355.93 and kill them.
+7 KILL ^TMP("IBY343",$JOB)
+8 SET IBIEN=0
+9 FOR
SET IBIEN=$ORDER(^IBA(355.93,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+10 MERGE ^TMP("IBY343",$JOB,IBIEN,"NPI")=^IBA(355.93,IBIEN,"NPI")
+11 KILL ^IBA(355.93,IBIEN,"NPI")
+12 QUIT
End DoDot:1
+13 ; Remove the multiple from the DD
+14 KILL DA,DIK,DIC
+15 SET DIK="^DD(355.93,"
SET DA=40
SET DA(1)=355.93
DO ^DIK
+16 ; Remove the DD entries in the multiple
+17 KILL DA,DIK,DIC
+18 SET DIK="^DD(355.9301,"
SET DA=.04
SET DA(1)=355.9301
DO ^DIK
+19 SET DIK="^DD(355.9301,"
SET DA=.03
SET DA(1)=355.9301
DO ^DIK
+20 SET DIK="^DD(355.9301,"
SET DA=.02
SET DA(1)=355.9301
DO ^DIK
+21 SET DIK="^DD(355.9301,"
SET DA=.01
SET DA(1)=355.9301
DO ^DIK
+22 ; Remove the remainder of DD entries in the multiple
+23 KILL ^DD(355.9301,0)
+24 QUIT
+25 ;
DELPIT ; Delete included provider ID type entries
+1 NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
+2 SET DIK="^IBE(355.97,"
FOR LN=2:1
SET TAG="PIT+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
Begin DoDot:1
+3 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBE(355.97,DA,0))
DO ^DIK
+4 QUIT
End DoDot:1
DELPITX ;
+1 QUIT
+2 ;
INCPIT(Y) ; Function to determine if provider ID type entry should be included in the build
+1 ; Y=ien to check in file 355.97
+2 ;
+3 NEW OK,LN,TAG,DATA
+4 SET OK=0
+5 FOR LN=2:1
SET TAG="PIT+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
IF $FIND(DATA,U_Y_U)
SET OK=1
QUIT
INCPITX ;
+1 QUIT OK
+2 ;
DELOF ; Delete included output formatter entries
+1 NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
+2 FOR FILE=5,6,7
SET DIK="^IBA(364."_FILE_","
FOR LN=2:1
SET TAG="ENT"_FILE_"+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
Begin DoDot:1
+3 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBA("364."_FILE,DA,0))
DO ^DIK
+4 QUIT
End DoDot:1
DELOFX ;
+1 QUIT
+2 ;
INCLUDE(FILE,Y) ; Function to determine if output formatter entry should be included in the build
+1 ; FILE=5,6,7 indicating file 364.x
+2 ; Y=ien to check
+3 ;
+4 NEW OK,LN,TAG,DATA
+5 SET OK=0
+6 FOR LN=2:1
SET TAG="ENT"_FILE_"+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
IF $FIND(DATA,U_Y_U)
SET OK=1
QUIT
INCLUDEX ;
+1 QUIT OK
+2 ;
PIT ; provider ID type entries in file 355.97 to be included
+1 ;
+2 ;;^35^
+3 ;;
+4 ;
ENT5 ; output formatter entries in file 364.5 to be included
+1 ;
+2 ;;^320^321^322^323^
+3 ;;
+4 ;
ENT6 ; output formatter entries in file 364.6 to be included
+1 ;
+2 ;;^1323^1324^1325^1326^1327^1328^1329^1330^1331^1332^1333^1334^1335^1336^1337^1338^1339^
+3 ;;
+4 ;
ENT7 ; output formatter entries in file 364.7 to be included
+1 ;
+2 ;;^1015^1041^1042^1043^1044^1045^1046^1047^1048^1049^1050^1051^1052^1053^1054^1055^1056^1057^
+3 ;;
+4 ;
