- IB20PT71 ;ALB/CPM - REMOVE OPTIONS FROM MENUS ; 11-FEB-94
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- D DEL ; Delete 'IB UB-82 TEST PATTERN PRINT' from output menu
- D NEWF ; Delete 'New Features of Integrated Billing' from menus
- D NEWCR ; Add new cancellation reasons into file #350.3
- Q
- ;
- ;
- DEL ; Delete 'IB UB-82 TEST PATTERN PRINT' from 'IB OUTPUT PATIENT REPORT MENU'
- S Y=$O(^DIC(19,"B","IB OUTPUT PATIENT REPORT MENU",0)) Q:Y=""
- S X=$O(^DIC(19,"B","IB UB-82 TEST PATTERN PRINT",0)) Q:X=""
- S X=$O(^DIC(19,+Y,10,"B",X,0)) Q:'X
- S DA(1)=+Y,DA=+X,DIK="^DIC(19,"_+Y_",10," D ^DIK K DA,DIK
- W !!,">>> Deleted IB UB-82 TEST PATTERN PRINT from IB OUTPUT PATIENT REPORT MENU..."
- Q
- ;
- NEWF ; Delete 'New Features of Integrated Billing' from menus
- S IBX=$O(^DIC(19,"B","IB NEW FEATURES 1.5",0)) I 'IBX G NEWFQ
- S IBN=0 F S IBN=$O(^DIC(19,"AD",IBX,IBN)) Q:'IBN D
- .S IBNAME=$G(^DIC(19,IBN,0)) Q:IBNAME=""
- .S IBY=0 F S IBY=$O(^DIC(19,"AD",IBX,IBN,IBY)) Q:'IBY D
- ..S DA(1)=IBN,DA=IBY,DIK="^DIC(19,"_IBN_",10," D ^DIK K DA,DIK
- ..W !!,">>> Deleted 'IB NEW FEATURES 1.5' from '",$P(IBNAME,"^"),"'"
- NEWFQ K DA,DIK,IBN,IBNAME,IBX,IBY
- Q
- ;
- NEWCR ; Add new cancellation reasons into file #350.3
- W !!,">>> Adding new cancellation reasons into file #350.3..."
- F IBI=1:1 S IBCR=$P($T(CRES+IBI),";;",2) Q:IBCR="QUIT" D
- .S X=$P(IBCR,"^")
- .I $O(^IBE(350.3,"B",X,0)) W !," >> '",X,"' is already on file..." Q
- .K DD,DO S DIC="^IBE(350.3,",DIC(0)="" D FILE^DICN Q:Y<0
- .S DIE=DIC,DA=+Y,DR=".02////"_$P(IBCR,"^",2)_";.03////"_$P(IBCR,"^",3) D ^DIE
- .W !," >> '",$P(IBCR,"^"),"' has been filed..."
- K DA,DIC,DIE,DR,IBI,IBCR,X,Y
- Q
- ;
- ;
- CRES ; Cancellation Reasons to add into file #350.3
- ;;MT CATEGORY CHANGED FROM C^NOT C^2
- ;;COMP & PENSION VISIT RECORDED^CNP VST^2
- ;;CHAMPVA ADMISSION DELETED^CVA DEL^2
- ;;RECD INPATIENT CARE^INP CARE^2
- ;;CHECK OUT DELETED^CO DEL^2
- ;;CLASSIFICATION CHANGED^CLS CHNG^2
- ;;RESEARCH VISIT/ADMISSION^RES VST^2
- ;;SERVICE CONNECTED VISIT/ADM^SER CONN^2
- ;;HARDSHIP GRANTED^HRDSHP^2
- ;;ADJUDICATED AS CATEGORY A^ADJ A^2
- ;;TREATED AT OTHER FACILITY^OTH FAC^2
- ;;AGENT ORANGE RELATED VISIT^AO VST^2
- ;;IONIZING RAD RELATED VISIT^IO VST^2
- ;;ENV CONTAMINANT RELATED VISIT^EC VST^2
- ;;CLASS II DENTAL VISIT^DENTL^2
- ;;QUIT
- IB20PT71 ;ALB/CPM - REMOVE OPTIONS FROM MENUS ; 11-FEB-94
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- +3 ; Delete 'IB UB-82 TEST PATTERN PRINT' from output menu
- DO DEL
- +4 ; Delete 'New Features of Integrated Billing' from menus
- DO NEWF
- +5 ; Add new cancellation reasons into file #350.3
- DO NEWCR
- +6 QUIT
- +7 ;
- +8 ;
- DEL ; Delete 'IB UB-82 TEST PATTERN PRINT' from 'IB OUTPUT PATIENT REPORT MENU'
- +1 SET Y=$ORDER(^DIC(19,"B","IB OUTPUT PATIENT REPORT MENU",0))
- IF Y=""
- QUIT
- +2 SET X=$ORDER(^DIC(19,"B","IB UB-82 TEST PATTERN PRINT",0))
- IF X=""
- QUIT
- +3 SET X=$ORDER(^DIC(19,+Y,10,"B",X,0))
- IF 'X
- QUIT
- +4 SET DA(1)=+Y
- SET DA=+X
- SET DIK="^DIC(19,"_+Y_",10,"
- DO ^DIK
- KILL DA,DIK
- +5 WRITE !!,">>> Deleted IB UB-82 TEST PATTERN PRINT from IB OUTPUT PATIENT REPORT MENU..."
- +6 QUIT
- +7 ;
- NEWF ; Delete 'New Features of Integrated Billing' from menus
- +1 SET IBX=$ORDER(^DIC(19,"B","IB NEW FEATURES 1.5",0))
- IF 'IBX
- GOTO NEWFQ
- +2 SET IBN=0
- FOR
- SET IBN=$ORDER(^DIC(19,"AD",IBX,IBN))
- IF 'IBN
- QUIT
- Begin DoDot:1
- +3 SET IBNAME=$GET(^DIC(19,IBN,0))
- IF IBNAME=""
- QUIT
- +4 SET IBY=0
- FOR
- SET IBY=$ORDER(^DIC(19,"AD",IBX,IBN,IBY))
- IF 'IBY
- QUIT
- Begin DoDot:2
- +5 SET DA(1)=IBN
- SET DA=IBY
- SET DIK="^DIC(19,"_IBN_",10,"
- DO ^DIK
- KILL DA,DIK
- +6 WRITE !!,">>> Deleted 'IB NEW FEATURES 1.5' from '",$PIECE(IBNAME,"^"),"'"
- End DoDot:2
- End DoDot:1
- NEWFQ KILL DA,DIK,IBN,IBNAME,IBX,IBY
- +1 QUIT
- +2 ;
- NEWCR ; Add new cancellation reasons into file #350.3
- +1 WRITE !!,">>> Adding new cancellation reasons into file #350.3..."
- +2 FOR IBI=1:1
- SET IBCR=$PIECE($TEXT(CRES+IBI),";;",2)
- IF IBCR="QUIT"
- QUIT
- Begin DoDot:1
- +3 SET X=$PIECE(IBCR,"^")
- +4 IF $ORDER(^IBE(350.3,"B",X,0))
- WRITE !," >> '",X,"' is already on file..."
- QUIT
- +5 KILL DD,DO
- SET DIC="^IBE(350.3,"
- SET DIC(0)=""
- DO FILE^DICN
- IF Y<0
- QUIT
- +6 SET DIE=DIC
- SET DA=+Y
- SET DR=".02////"_$PIECE(IBCR,"^",2)_";.03////"_$PIECE(IBCR,"^",3)
- DO ^DIE
- +7 WRITE !," >> '",$PIECE(IBCR,"^"),"' has been filed..."
- End DoDot:1
- +8 KILL DA,DIC,DIE,DR,IBI,IBCR,X,Y
- +9 QUIT
- +10 ;
- +11 ;
- CRES ; Cancellation Reasons to add into file #350.3
- +1 ;;MT CATEGORY CHANGED FROM C^NOT C^2
- +2 ;;COMP & PENSION VISIT RECORDED^CNP VST^2
- +3 ;;CHAMPVA ADMISSION DELETED^CVA DEL^2
- +4 ;;RECD INPATIENT CARE^INP CARE^2
- +5 ;;CHECK OUT DELETED^CO DEL^2
- +6 ;;CLASSIFICATION CHANGED^CLS CHNG^2
- +7 ;;RESEARCH VISIT/ADMISSION^RES VST^2
- +8 ;;SERVICE CONNECTED VISIT/ADM^SER CONN^2
- +9 ;;HARDSHIP GRANTED^HRDSHP^2
- +10 ;;ADJUDICATED AS CATEGORY A^ADJ A^2
- +11 ;;TREATED AT OTHER FACILITY^OTH FAC^2
- +12 ;;AGENT ORANGE RELATED VISIT^AO VST^2
- +13 ;;IONIZING RAD RELATED VISIT^IO VST^2
- +14 ;;ENV CONTAMINANT RELATED VISIT^EC VST^2
- +15 ;;CLASS II DENTAL VISIT^DENTL^2
- +16 ;;QUIT
