PRPFIPST ; ;1/7/98 12:34 PM
;CTB/WASH-ISC@ALTOONA PATIENT FUNDS XREF CONVERSION ;1/6/98 4:33 PM
V ;;3.0;PATIENT FUNDS;**6,7**;JUNE 1, 1989
;LOOP THROUGH 470 GET POINTER
;DISPLAY FILE 16 AND FILE 200 VALUE
;SELECT NUMBER IN FILE 16 LINE WHICH ARE WRONG
;PROCESS CHANGES
N %DT,CONVDATE,UNINSTAL,%A,%B,%,DA,Y
S %DT("A")="Select Date of Installation of Patch PRPF*3*6: ",%DT="AE",DT("?")="Enter the date the Data Dictionaries for Patch PRPF*3*6 were installed. " D ^%DT
QUIT:Y<0
S CONVDATE=+Y
S UNINSTAL=0
S %=1,%A="Do you wish to prepare an UNINSTALL File",%B="An UNINSTALL file will permit you to reverse this action." D ^PRPFYN Q:%<1
I %=1 S UNINSTAL=1
W !! S %A="OK TO BEGIN",%=2,%B="" D ^PRPFYN
I %'=1 W !!,"NO ACTION TAKEN" Q
K ^TMP("PRPF UNINSTALL")
S DA=0 F S DA=$O(^PRPF(470,DA)) Q:'DA D
. N OLDDA,NEWDA,RDATE
. S X=$G(^PRPF(470,DA,0))
. S RDATE=+$P(X,"^",12) I RDATE>CONVDATE QUIT
. S OLDDA=$P(X,"^",13) Q:OLDDA=""
. S NEWDA=$G(^DIC(16,OLDDA,"A3")) Q:NEWDA=""
. S $P(^PRPF(470,DA,0),"^",13)=NEWDA I UNINSTAL=1 S ^TMP("PRPF UNINSTALL",DA)=OLDDA W "."
. QUIT
W !,"DONE. " I UNINSTAL,$D(^TMP("PRPF UNINSTALL")) W "UNINSTALL OPTION AVAILABLE." W !!
Q
UNINSTAL ;
N %A,%B,%,DA
I '$D(^TMP("PRPF UNINSTALL")) W !,*7,"No Uninstall file available" QUIT
S %=1,%A="This option will reverse the Provider Conversion for Patient Funds Patch PRPF*3*7",%A(1)="OK TO CONTINUE",%B="" D ^PRPFYN
I %'=1 W !,"NO ACTION TAKEN" QUIT
S DA=0 F S DA=$O(^TMP("PRPF UNINSTALL",DA)) Q:'DA S $P(^PRPF(470,DA,0),"^",13)=^TMP("PRPF UNINSTALL",DA) K ^TMP("PRPF UNINSTALL",DA)
W !,"UNINSTALL COMPLETED"
QUIT
REMOVE ;
N %A,%B,%
I '$D(^TMP("PRPF UNINSTALL")) W !,*7,"No Uninstall file available to remove." QUIT
S %=1,%A="This option will remove the ^TMP("_""""_"PRPF UNINSTALL"_""""_")) global.",%A(1)="Removal will prevent recovery of original, pre-conversion data.",%A(2)="MAKE SURE YOU HAVE VERIFIED THE CONVERSION."
S %A(3)="",%A(4)="OK TO CONTINUE",%B="" D ^PRPFYN
I %'=1 W !,"NO ACTION TAKEN" QUIT
K ^TMP("PRPF UNINSTALL")
W !!,"UNINSTALL FILE REMOVED"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFIPST 2129 printed Apr 09, 2024@21:04:37 Page 2
PRPFIPST ; ;1/7/98 12:34 PM
+1 ;CTB/WASH-ISC@ALTOONA PATIENT FUNDS XREF CONVERSION ;1/6/98 4:33 PM
V ;;3.0;PATIENT FUNDS;**6,7**;JUNE 1, 1989
+1 ;LOOP THROUGH 470 GET POINTER
+2 ;DISPLAY FILE 16 AND FILE 200 VALUE
+3 ;SELECT NUMBER IN FILE 16 LINE WHICH ARE WRONG
+4 ;PROCESS CHANGES
+5 NEW %DT,CONVDATE,UNINSTAL,%A,%B,%,DA,Y
+6 SET %DT("A")="Select Date of Installation of Patch PRPF*3*6: "
SET %DT="AE"
SET DT("?")="Enter the date the Data Dictionaries for Patch PRPF*3*6 were installed. "
DO ^%DT
+7 if Y<0
QUIT
+8 SET CONVDATE=+Y
+9 SET UNINSTAL=0
+10 SET %=1
SET %A="Do you wish to prepare an UNINSTALL File"
SET %B="An UNINSTALL file will permit you to reverse this action."
DO ^PRPFYN
if %<1
QUIT
+11 IF %=1
SET UNINSTAL=1
+12 WRITE !!
SET %A="OK TO BEGIN"
SET %=2
SET %B=""
DO ^PRPFYN
+13 IF %'=1
WRITE !!,"NO ACTION TAKEN"
QUIT
+14 KILL ^TMP("PRPF UNINSTALL")
+15 SET DA=0
FOR
SET DA=$ORDER(^PRPF(470,DA))
if 'DA
QUIT
Begin DoDot:1
+16 NEW OLDDA,NEWDA,RDATE
+17 SET X=$GET(^PRPF(470,DA,0))
+18 SET RDATE=+$PIECE(X,"^",12)
IF RDATE>CONVDATE
QUIT
+19 SET OLDDA=$PIECE(X,"^",13)
if OLDDA=""
QUIT
+20 SET NEWDA=$GET(^DIC(16,OLDDA,"A3"))
if NEWDA=""
QUIT
+21 SET $PIECE(^PRPF(470,DA,0),"^",13)=NEWDA
IF UNINSTAL=1
SET ^TMP("PRPF UNINSTALL",DA)=OLDDA
WRITE "."
+22 QUIT
End DoDot:1
+23 WRITE !,"DONE. "
IF UNINSTAL
IF $DATA(^TMP("PRPF UNINSTALL"))
WRITE "UNINSTALL OPTION AVAILABLE."
WRITE !!
+24 QUIT
UNINSTAL ;
+1 NEW %A,%B,%,DA
+2 IF '$DATA(^TMP("PRPF UNINSTALL"))
WRITE !,*7,"No Uninstall file available"
QUIT
+3 SET %=1
SET %A="This option will reverse the Provider Conversion for Patient Funds Patch PRPF*3*7"
SET %A(1)="OK TO CONTINUE"
SET %B=""
DO ^PRPFYN
+4 IF %'=1
WRITE !,"NO ACTION TAKEN"
QUIT
+5 SET DA=0
FOR
SET DA=$ORDER(^TMP("PRPF UNINSTALL",DA))
if 'DA
QUIT
SET $PIECE(^PRPF(470,DA,0),"^",13)=^TMP("PRPF UNINSTALL",DA)
KILL ^TMP("PRPF UNINSTALL",DA)
+6 WRITE !,"UNINSTALL COMPLETED"
+7 QUIT
REMOVE ;
+1 NEW %A,%B,%
+2 IF '$DATA(^TMP("PRPF UNINSTALL"))
WRITE !,*7,"No Uninstall file available to remove."
QUIT
+3 SET %=1
SET %A="This option will remove the ^TMP("_""""_"PRPF UNINSTALL"_""""_")) global."
SET %A(1)="Removal will prevent recovery of original, pre-conversion data."
SET %A(2)="MAKE SURE YOU HAVE VERIFIED THE CONVERSION."
+4 SET %A(3)=""
SET %A(4)="OK TO CONTINUE"
SET %B=""
DO ^PRPFYN
+5 IF %'=1
WRITE !,"NO ACTION TAKEN"
QUIT
+6 KILL ^TMP("PRPF UNINSTALL")
+7 WRITE !!,"UNINSTALL FILE REMOVED"
+8 QUIT
