- RAIPS211 ;WOIFO/KLM - Post-init Driver, patch 211 ; Feb 23, 2024@11:23
- ;;5.0;Radiology/Nuclear Medicine;**211**;Mar 16, 1998;Build 1
- ;
- EN ;entry point
- ;fall though
- BIRADR ;Update the BI-RAD R Code for FDA (Add display text, update name)
- N RAIENS,RADX,RAFDA,RAERR,RATXT S RADX=1107
- S RAIENS=RADX_","
- S RAFDA(78.3,RAIENS,100)="Post-Procedure Mammogram for Marker Placement"
- K RAERR D FILE^DIE("E","RAFDA","RAERR")
- I $D(RAERR("DIERR")) S RATXT(1)="Error updating BIRAD code "_RADX
- I $G(RATXT(1))="" S RATXT(1)=RADX_" Display text updated"
- D BMES^XPDUTL(.RATXT)
- ;Update .01
- S $P(^RA(78.3,RADX,0),U)="BI-RADS CATEGORY R"
- ;Take care of "B" x-ref
- K ^RA(78.3,"B","BI-RADS R",RADX)
- S DIK="^RA(78.3,",DA=RADX D IX^DIK
- K DA,DIK,RATXT
- S RATXT(1)=RADX_" Code name updated"
- D BMES^XPDUTL(.RATXT)
- ;fall through
- NOSHOW ;update NO SHOW reason for cancel/hold reason
- N RA01,RAIEN,RAIENS,RAFDA,RASCR,RATXT S RA01="PATIENT NO SHOWED"
- S RASCR="I $P(^(0),U,5)=""Y""" ;Nat'l flag
- S RAIEN=$$FIND1^DIC(75.2,,"X",.RA01,,.RASCR)
- I RAIEN>0 S RAIENS=RAIEN_"," D
- .K RAERR S RAFDA(75.2,RAIENS,2)=9 ;general request (cancel and hold)
- .D FILE^DIE(,"RAFDA","RAERR")
- .I $D(RAERR("DIERR")) S RATXT(1)="Error updating Reason "_RA01
- .I $G(RATXT(1))="" S RATXT(1)=RA01_" Updated"
- .D BMES^XPDUTL(.RATXT)
- I RAIEN<1 D
- .S RATXT(1)="Error updating Reason "_RA01
- .D BMES^XPDUTL(.RATXT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS211 1412 printed Jan 18, 2025@03:37:24 Page 2
- RAIPS211 ;WOIFO/KLM - Post-init Driver, patch 211 ; Feb 23, 2024@11:23
- +1 ;;5.0;Radiology/Nuclear Medicine;**211**;Mar 16, 1998;Build 1
- +2 ;
- EN ;entry point
- +1 ;fall though
- BIRADR ;Update the BI-RAD R Code for FDA (Add display text, update name)
- +1 NEW RAIENS,RADX,RAFDA,RAERR,RATXT
- SET RADX=1107
- +2 SET RAIENS=RADX_","
- +3 SET RAFDA(78.3,RAIENS,100)="Post-Procedure Mammogram for Marker Placement"
- +4 KILL RAERR
- DO FILE^DIE("E","RAFDA","RAERR")
- +5 IF $DATA(RAERR("DIERR"))
- SET RATXT(1)="Error updating BIRAD code "_RADX
- +6 IF $GET(RATXT(1))=""
- SET RATXT(1)=RADX_" Display text updated"
- +7 DO BMES^XPDUTL(.RATXT)
- +8 ;Update .01
- +9 SET $PIECE(^RA(78.3,RADX,0),U)="BI-RADS CATEGORY R"
- +10 ;Take care of "B" x-ref
- +11 KILL ^RA(78.3,"B","BI-RADS R",RADX)
- +12 SET DIK="^RA(78.3,"
- SET DA=RADX
- DO IX^DIK
- +13 KILL DA,DIK,RATXT
- +14 SET RATXT(1)=RADX_" Code name updated"
- +15 DO BMES^XPDUTL(.RATXT)
- +16 ;fall through
- NOSHOW ;update NO SHOW reason for cancel/hold reason
- +1 NEW RA01,RAIEN,RAIENS,RAFDA,RASCR,RATXT
- SET RA01="PATIENT NO SHOWED"
- +2 ;Nat'l flag
- SET RASCR="I $P(^(0),U,5)=""Y"""
- +3 SET RAIEN=$$FIND1^DIC(75.2,,"X",.RA01,,.RASCR)
- +4 IF RAIEN>0
- SET RAIENS=RAIEN_","
- Begin DoDot:1
- +5 ;general request (cancel and hold)
- KILL RAERR
- SET RAFDA(75.2,RAIENS,2)=9
- +6 DO FILE^DIE(,"RAFDA","RAERR")
- +7 IF $DATA(RAERR("DIERR"))
- SET RATXT(1)="Error updating Reason "_RA01
- +8 IF $GET(RATXT(1))=""
- SET RATXT(1)=RA01_" Updated"
- +9 DO BMES^XPDUTL(.RATXT)
- End DoDot:1
- +10 IF RAIEN<1
- Begin DoDot:1
- +11 SET RATXT(1)="Error updating Reason "_RA01
- +12 DO BMES^XPDUTL(.RATXT)
- End DoDot:1
- +13 QUIT