- 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 Mar 13, 2025@21:06:32 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
