SR48DIS ;BIR/ADM-Disposition conversion from set of codes to file; [ 09/19/96 8:22 PM ]
;;3.0; Surgery ;**48**;24 Jun 93
ENV Q:$P(^DD(130,.43,0),"^",2)'["S"
W !!,"This patch will convert the code in each of the following fields to a",!,"pointer to the SURGERY DISPOSITION file (#131.6):",!,?5,"REQ POSTOP CARE (#.43)",!,?5,"OP DISPOSITION (#.46)",!,?5,"PACU DISPOSITION (#.79)"
W !!,"If your facility has modified the set of codes for any of these 3 fields,",!,"the conversion process may not be able to convert those fields completely."
W !,"If dispositions have been added locally, the conversion process will attempt",!,"to add them to the SURGERY DISPOSITION file (#131.6)."
W !!,"Checking for local modifications to these fields..." S NOMOD=1
S MOD=0,SRX=$P(^DD(130,.43,0),"^",3),SRX1="M:MICU;S:SICU;C:CCU;I:STEPDOWN;W:WARD;O:OUTPATIENT;" S:SRX'=SRX1 MOD=1,NOMOD=0
I MOD W !!,">>> Local modifications detected in REQ POSTOP CARE (#.43)" D MOD
S MOD=0,SRX=$P(^DD(130,.46,0),"^",3),SRX1="R:PACU (RECOVERY ROOM);W:WARD;M:MICU;S:SICU;C:CCU;O:OUTPATIENT;I:STEP DOWN;D:MORGUE;" S:SRX'=SRX1 MOD=1,NOMOD=0
I MOD W !!,">>> Local modifications detected in OP DISPOSITION (#.46)" D MOD
S MOD=0,SRX=$P(^DD(130,.79,0),"^",3),SRX1="M:MICU;S:SICU;C:CCU;I:STEP DOWN;O:OUTPATIENT;D:DEATH;W:WARD;OR:OPERATING ROOM;" S:SRX'=SRX1 MOD=1,NOMOD=0
I MOD W !!,">>> Local modifications detected in PACU DISPOSITION (#.79)" D MOD
I 'NOMOD W !!,"Any fields that cannot be converted will be listed and will have to be",!,"converted manually using VA FileMan.",!
I NOMOD W !!,"No local modifications found."
W ! K DIR S DIR("?",1)="Enter YES to proceed with this patch installation. Enter NO or '^' to exit",DIR("?")="without making any changes."
S DIR("A")="Are you sure you want to continue (Y/N)",DIR(0)="Y" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) S XPDQUIT=2 G END
Q
PRE ; entry for pre-init process
Q:$P(^DD(130,.43,0),"^",2)'["S"
N %
S %=$$NEWCP^XPDUTL("SR481","GO^SR48DIS","0")
Q
GO ; install data in file 131.6
D BMES^XPDUTL("Installing data for SURGERY DISPOSITION file (#131.6)...")
D ^SR48DIS0
S SRX=$P(^DD(130,.43,0),"^",3),SRX1="M:MICU;S:SICU;C:CCU;I:STEPDOWN;W:WARD;O:OUTPATIENTI;" D COMP
S SRX=$P(^DD(130,.46,0),"^",3),SRX1="R:PACU (RECOVERY ROOM);W:WARD;M:MICU;S:SICU;C:CCU;O:OUTPATIENT;I:STEP DOWN;D:MORGUE;" D COMP
S SRX=$P(^DD(130,.79,0),"^",3),SRX1="M:MICU;S:SICU;C:CCU;I:STEP DOWN;O:OUTPATIENT;D:DEATH;W:WARD;OR:OPERATING ROOM;" D COMP
CONV ; convert data in file 130
K ^TMP("SR48",$J) S SRNODE=5,SRCASES=0 D BMES^XPDUTL("Beginning automatic conversion of disposition data fields...")
; get parameter value to initialize SRTN
S SRTN=$$PARCP^XPDUTL("SR481")
F S SRTN=$O(^SRF(SRTN)) Q:'SRTN D DISP S %=$$UPCP^XPDUTL("SR481",SRTN)
D MES^XPDUTL("Automatic conversion process is finished.")
I SRNODE=5 D MES^XPDUTL("No manual conversions will be necessary.")
I SRNODE>5 D
.D MES^XPDUTL("Some manual conversions will be necessary. See mail message for details.")
.D NOW^%DTC S SRNOW=$E(%,1,12),SRNOW=$$FMTE^XLFDT(SRNOW)
.S ^TMP("SR48",$J,1)="The patch SR*3*48 data conversion process finished "_SRNOW_".",^TMP("SR48",$J,2)=""
.S ^TMP("SR48",$J,3)="The following is a list of disposition fields that could not be converted.",^TMP("SR48",$J,4)=""
.S XMSUB="SR*3*48 Disposition Data Conversion",XMDUZ=DUZ,XMY(DUZ)="",XMTEXT="^TMP(""SR48"",$J," D ^XMD K XMSUB,XMTEXT,XMY,^TMP("SR48",$J)
END K MOD,NOMOD,SRTN D ^SRSKILL
Q
COMP I SRX=SRX1 Q
F SRI=1:1 S SRJ=$P(SRX,";",SRI) Q:SRJ="" S SRCODE=$P(SRJ,":"),SRDISP=$P(SRJ,":",2) D
.S SRE=$O(^SRO(131.6,"B",SRDISP,0)) S:'SRE SRE=$O(^SRO(131.6,"D",SRDISP,0)) I SRE,SRCODE'=$P(^SRO(131.6,SRE,0),"^",2) S ^SRO(131.6,"C",SRCODE,SRE)="" Q
.I 'SRE D
..S SR(0)=^SRO(131.6,0),X=$P(SR(0),"^",3)+1,Y=$P(SR(0),"^",4)+1,^SRO(131.6,Y,0)=SRDISP_"^"_SRCODE,^SRO(131.6,"B",SRDISP,Y)="",^SRO(131.6,"C",SRCODE,Y)="",$P(^SRO(131.6,0),"^",3,4)=X_"^"_Y
..D MES^XPDUTL(SRDISP_" added to SURGERY DISPOSITION file (#131.6)")
Q
DISP ; point fields .43, .46 and .79 to SURGERY DISPOSITION file
S SRC=0,SRL=.43,SRY=$P($G(^SRF(SRTN,.4)),"^",3) D C I SRC S $P(^SRF(SRTN,.4),"^",3)=SRX
S SRC=0,SRL=.46,SRY=$P($G(^SRF(SRTN,.4)),"^",6) D C I SRC S $P(^SRF(SRTN,.4),"^",6)=SRX
S SRC=0,SRL=.79,SRY=$P($G(^SRF(SRTN,.7)),"^",9) D C I SRC S $P(^SRF(SRTN,.7),"^",9)=SRX
S SRCASES=SRCASES+1 I '(SRCASES#1000) D MES^XPDUTL(" "_SRCASES_" cases processed...")
Q
C Q:SRY="" S (SRCT,SRZ)=0 F S SRZ=$O(^SRO(131.6,"C",SRY,SRZ)) Q:'SRZ S SRCT=SRCT+1,SRX=SRZ
I SRCT=1 S SRC=1 Q
NOMTCH ; if match for code cannot cannot be determined, write message
S ^TMP("SR48",$J,SRNODE)="Cannot convert field "_SRL_" on case #"_SRTN_". Must convert manually.",SRNODE=SRNODE+1
Q
MOD ; if local mods, display standard codes and site codes
W !!,"* Standard Set *",?30,"* Your Set *",!,"Code:Stands For",?30,"Code:Stands For",!,"---------------",?30,"---------------",!
F I=1:1 S X=$P(SRX1,";",I) W:X'="" X S Y=$P(SRX,";",I) W:Y'="" ?30,Y Q:X=""&(Y="") W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR48DIS 5054 printed Apr 09, 2024@21:40:34 Page 2
SR48DIS ;BIR/ADM-Disposition conversion from set of codes to file; [ 09/19/96 8:22 PM ]
+1 ;;3.0; Surgery ;**48**;24 Jun 93
ENV if $PIECE(^DD(130,.43,0),"^",2)'["S"
QUIT
+1 WRITE !!,"This patch will convert the code in each of the following fields to a",!,"pointer to the SURGERY DISPOSITION file (#131.6):",!,?5,"REQ POSTOP CARE (#.43)",!,?5,"OP DISPOSITION (#.46)",!,?5,"PACU DISPOSITION (#.79)"
+2 WRITE !!,"If your facility has modified the set of codes for any of these 3 fields,",!,"the conversion process may not be able to convert those fields completely."
+3 WRITE !,"If dispositions have been added locally, the conversion process will attempt",!,"to add them to the SURGERY DISPOSITION file (#131.6)."
+4 WRITE !!,"Checking for local modifications to these fields..."
SET NOMOD=1
+5 SET MOD=0
SET SRX=$PIECE(^DD(130,.43,0),"^",3)
SET SRX1="M:MICU;S:SICU;C:CCU;I:STEPDOWN;W:WARD;O:OUTPATIENT;"
if SRX'=SRX1
SET MOD=1
SET NOMOD=0
+6 IF MOD
WRITE !!,">>> Local modifications detected in REQ POSTOP CARE (#.43)"
DO MOD
+7 SET MOD=0
SET SRX=$PIECE(^DD(130,.46,0),"^",3)
SET SRX1="R:PACU (RECOVERY ROOM);W:WARD;M:MICU;S:SICU;C:CCU;O:OUTPATIENT;I:STEP DOWN;D:MORGUE;"
if SRX'=SRX1
SET MOD=1
SET NOMOD=0
+8 IF MOD
WRITE !!,">>> Local modifications detected in OP DISPOSITION (#.46)"
DO MOD
+9 SET MOD=0
SET SRX=$PIECE(^DD(130,.79,0),"^",3)
SET SRX1="M:MICU;S:SICU;C:CCU;I:STEP DOWN;O:OUTPATIENT;D:DEATH;W:WARD;OR:OPERATING ROOM;"
if SRX'=SRX1
SET MOD=1
SET NOMOD=0
+10 IF MOD
WRITE !!,">>> Local modifications detected in PACU DISPOSITION (#.79)"
DO MOD
+11 IF 'NOMOD
WRITE !!,"Any fields that cannot be converted will be listed and will have to be",!,"converted manually using VA FileMan.",!
+12 IF NOMOD
WRITE !!,"No local modifications found."
+13 WRITE !
KILL DIR
SET DIR("?",1)="Enter YES to proceed with this patch installation. Enter NO or '^' to exit"
SET DIR("?")="without making any changes."
+14 SET DIR("A")="Are you sure you want to continue (Y/N)"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)
SET XPDQUIT=2
GOTO END
+15 QUIT
PRE ; entry for pre-init process
+1 if $PIECE(^DD(130,.43,0),"^",2)'["S"
QUIT
+2 NEW %
+3 SET %=$$NEWCP^XPDUTL("SR481","GO^SR48DIS","0")
+4 QUIT
GO ; install data in file 131.6
+1 DO BMES^XPDUTL("Installing data for SURGERY DISPOSITION file (#131.6)...")
+2 DO ^SR48DIS0
+3 SET SRX=$PIECE(^DD(130,.43,0),"^",3)
SET SRX1="M:MICU;S:SICU;C:CCU;I:STEPDOWN;W:WARD;O:OUTPATIENTI;"
DO COMP
+4 SET SRX=$PIECE(^DD(130,.46,0),"^",3)
SET SRX1="R:PACU (RECOVERY ROOM);W:WARD;M:MICU;S:SICU;C:CCU;O:OUTPATIENT;I:STEP DOWN;D:MORGUE;"
DO COMP
+5 SET SRX=$PIECE(^DD(130,.79,0),"^",3)
SET SRX1="M:MICU;S:SICU;C:CCU;I:STEP DOWN;O:OUTPATIENT;D:DEATH;W:WARD;OR:OPERATING ROOM;"
DO COMP
CONV ; convert data in file 130
+1 KILL ^TMP("SR48",$JOB)
SET SRNODE=5
SET SRCASES=0
DO BMES^XPDUTL("Beginning automatic conversion of disposition data fields...")
+2 ; get parameter value to initialize SRTN
+3 SET SRTN=$$PARCP^XPDUTL("SR481")
+4 FOR
SET SRTN=$ORDER(^SRF(SRTN))
if 'SRTN
QUIT
DO DISP
SET %=$$UPCP^XPDUTL("SR481",SRTN)
+5 DO MES^XPDUTL("Automatic conversion process is finished.")
+6 IF SRNODE=5
DO MES^XPDUTL("No manual conversions will be necessary.")
+7 IF SRNODE>5
Begin DoDot:1
+8 DO MES^XPDUTL("Some manual conversions will be necessary. See mail message for details.")
+9 DO NOW^%DTC
SET SRNOW=$EXTRACT(%,1,12)
SET SRNOW=$$FMTE^XLFDT(SRNOW)
+10 SET ^TMP("SR48",$JOB,1)="The patch SR*3*48 data conversion process finished "_SRNOW_"."
SET ^TMP("SR48",$JOB,2)=""
+11 SET ^TMP("SR48",$JOB,3)="The following is a list of disposition fields that could not be converted."
SET ^TMP("SR48",$JOB,4)=""
+12 SET XMSUB="SR*3*48 Disposition Data Conversion"
SET XMDUZ=DUZ
SET XMY(DUZ)=""
SET XMTEXT="^TMP(""SR48"",$J,"
DO ^XMD
KILL XMSUB,XMTEXT,XMY,^TMP("SR48",$JOB)
End DoDot:1
END KILL MOD,NOMOD,SRTN
DO ^SRSKILL
+1 QUIT
COMP IF SRX=SRX1
QUIT
+1 FOR SRI=1:1
SET SRJ=$PIECE(SRX,";",SRI)
if SRJ=""
QUIT
SET SRCODE=$PIECE(SRJ,":")
SET SRDISP=$PIECE(SRJ,":",2)
Begin DoDot:1
+2 SET SRE=$ORDER(^SRO(131.6,"B",SRDISP,0))
if 'SRE
SET SRE=$ORDER(^SRO(131.6,"D",SRDISP,0))
IF SRE
IF SRCODE'=$PIECE(^SRO(131.6,SRE,0),"^",2)
SET ^SRO(131.6,"C",SRCODE,SRE)=""
QUIT
+3 IF 'SRE
Begin DoDot:2
+4 SET SR(0)=^SRO(131.6,0)
SET X=$PIECE(SR(0),"^",3)+1
SET Y=$PIECE(SR(0),"^",4)+1
SET ^SRO(131.6,Y,0)=SRDISP_"^"_SRCODE
SET ^SRO(131.6,"B",SRDISP,Y)=""
SET ^SRO(131.6,"C",SRCODE,Y)=""
SET $PIECE(^SRO(131.6,0),"^",3,4)=X_"^"_Y
+5 DO MES^XPDUTL(SRDISP_" added to SURGERY DISPOSITION file (#131.6)")
End DoDot:2
End DoDot:1
+6 QUIT
DISP ; point fields .43, .46 and .79 to SURGERY DISPOSITION file
+1 SET SRC=0
SET SRL=.43
SET SRY=$PIECE($GET(^SRF(SRTN,.4)),"^",3)
DO C
IF SRC
SET $PIECE(^SRF(SRTN,.4),"^",3)=SRX
+2 SET SRC=0
SET SRL=.46
SET SRY=$PIECE($GET(^SRF(SRTN,.4)),"^",6)
DO C
IF SRC
SET $PIECE(^SRF(SRTN,.4),"^",6)=SRX
+3 SET SRC=0
SET SRL=.79
SET SRY=$PIECE($GET(^SRF(SRTN,.7)),"^",9)
DO C
IF SRC
SET $PIECE(^SRF(SRTN,.7),"^",9)=SRX
+4 SET SRCASES=SRCASES+1
IF '(SRCASES#1000)
DO MES^XPDUTL(" "_SRCASES_" cases processed...")
+5 QUIT
C if SRY=""
QUIT
SET (SRCT,SRZ)=0
FOR
SET SRZ=$ORDER(^SRO(131.6,"C",SRY,SRZ))
if 'SRZ
QUIT
SET SRCT=SRCT+1
SET SRX=SRZ
+1 IF SRCT=1
SET SRC=1
QUIT
NOMTCH ; if match for code cannot cannot be determined, write message
+1 SET ^TMP("SR48",$JOB,SRNODE)="Cannot convert field "_SRL_" on case #"_SRTN_". Must convert manually."
SET SRNODE=SRNODE+1
+2 QUIT
MOD ; if local mods, display standard codes and site codes
+1 WRITE !!,"* Standard Set *",?30,"* Your Set *",!,"Code:Stands For",?30,"Code:Stands For",!,"---------------",?30,"---------------",!
+2 FOR I=1:1
SET X=$PIECE(SRX1,";",I)
if X'=""
WRITE X
SET Y=$PIECE(SRX,";",I)
if Y'=""
WRITE ?30,Y
if X=""&(Y="")
QUIT
WRITE !
+3 QUIT
