- XUPCF ;BT/BP-OAK Person Class File APIs; 2/4/2010
- ;;8.0;KERNEL;**541**; July 10, 1995;Build 8
- ;;Per VHA Directive 2004-038, this routine should not be modified
- ;;these APIs are for updating Person Class File and for Kernal Team only.
- ;;
- ;;REFERENCED BY: PROVIDER TYPE(B), PROVIDER TYPE(C), CLASSIFICATION(D),
- ;; AREA OF SPECIALIZATION(E), VA CODE(F), X12 CODE(G)
- ;;^USC(8932.1,D0,0)= (#.01) PROVIDER TYPE [1F] ^ (#1) CLASSIFICATION [2F] ^
- ;; ==>(#2) AREA OF SPECIALIZATION [3F] ^ (#3) STATUS [4S] ^ (#4)
- ;; ==>DATE INACTIVATED [5D] ^ (#5) VA CODE [6F] ^ (#6) X12 CODE
- ;; ==>[7F] ^ (#7) reserved [8F] ^ (#8) SPECIALTY CODE [9F] ^
- ;;^USC(8932.1,D0,11,0)=^8932.111^^ (#11) DEFINITION
- ;;^USC(8932.1,D0,11,D1,0)= (#.01) DEFINITION [1W] ^
- ;;^USC(8932.1,D0,90002)= ^ (#90002) INDIVIDUAL/NON [2S] ^
- Q
- ;
- GET(XUIEN) ;
- I $G(XUIEN)'=+$G(XUIEN) W !,"Invalid IEN" Q
- W !,"PROVIDER TYPE",?24,": ",$$GET01(XUIEN)
- W !,"CLASSIFICATION",?24,": ",$$GET1(XUIEN)
- W !,"AREA OF SPECIALIZATION",?24,": ",$$GET2(XUIEN)
- W !,"STATUS",?24,": ",$$GET3(XUIEN)
- W !,"DATE INACTIVATED",?24,": ",$$GET4(XUIEN)
- W !,"VA CODE",?24,": ",$$GET5(XUIEN)
- W !,"X12 CODE",?24,": ",$$GET6(XUIEN)
- W !,"SPECIALTY CODE",?24,": ",$$GET8(XUIEN)
- Q
- ;
- SET(XUIEN,XUDATA) ;
- I $G(XUIEN)'=+$G(XUIEN) W !,"Invalid IEN" Q
- I $G(XUDATA)="" W !,"Invalid data" Q
- N XUDA01 S XUDA01=$P(XUDATA,"^",1),XUDA01=$$SET01(XUDA01,XUIEN)
- N XUDA1 S XUDA1=$P(XUDATA,"^",2),XUDA1=$$SET1(XUDA01,XUIEN)
- N XUDA2 S XUDA2=$P(XUDATA,"^",3),XUDA2=$$SET2(XUDA2,XUIEN)
- N XUDA3 S XUDA3=$P(XUDATA,"^",4),XUDA3=$$SET3(XUDA3,XUIEN)
- N XUDA4 S XUDA4=$P(XUDATA,"^",5),XUDA4=$$SET4(XUDA4,XUIEN)
- N XUDA5 S XUDA5=$P(XUDATA,"^",6),XUDA5=$$SET5(XUDA5,XUIEN)
- N XUDA6 S XUDA6=$P(XUDATA,"^",7),XUDA6=$$SET6(XUDA6,XUIEN)
- N XUDA8 S XUDA8=$P(XUDATA,"^",8),XUDA8=$$SET8(XUDA8,XUIEN)
- Q
- ;
- GET01(XUIEN) ;get PROVIDER TYPE by IEN
- N XUNAME
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- Q $P(XUNAME,"^",1)
- ;
- SET01(XUPRO,XUIEN) ;set/add a new PROVIDER TYPE by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",.01)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- ;
- GET1(XUIEN) ;get CLASSIFICATION by IEN
- N XUNAME
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- Q $P(XUNAME,"^",2)
- ;
- SET1(XUPRO,XUIEN) ;set/add CLASSIFICATION by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",1)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- ;
- GET2(XUIEN) ;get AREA OF SPECIALIZATION by IEN
- N XUNAME
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- Q $P(XUNAME,"^",3)
- ;
- SET2(XUPRO,XUIEN) ;set/add AREA OF SPECIALIZATION by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",2)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- ;
- GET3(XUIEN) ;get STATUS by IEN
- N XUNAME
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- I $P(XUNAME,"^",4)="a" Q "Active"
- Q "Inactive"
- ;
- SET3(XUPRO,XUIEN) ;set/add STATUS by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",3)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- ;
- GET4(XUIEN) ;get DATE INACTIVATED by IEN
- N XUNAME,XUDATE
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- S XUDATE=$P(XUNAME,"^",5)
- Q $$FMTE^XLFDT(XUDATE)
- ;
- SET4(XUPRO,XUIEN) ;set/add DATE INACTIVATED by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",4)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- ;
- GET5(XUIEN) ;get VA CODE by IEN
- N XUNAME
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- Q $P(XUNAME,"^",6)
- ;
- SET5(XUPRO,XUIEN) ;set/add VA CODE by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",5)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- ;
- GET6(XUIEN) ;get X12 CODE by IEN
- N XUNAME
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- Q $P(XUNAME,"^",7)
- ;
- SET6(XUPRO,XUIEN) ;set/add X12 CODE by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",6)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- ;
- GET8(XUIEN) ;get SPECIALTY CODE by IEN
- N XUNAME
- I $G(XUIEN)'=+$G(XUIEN) Q "Invalid IEN"
- S XUNAME=$G(^USC(8932.1,XUIEN,0)) I XUNAME="" Q "Invalid IEN"
- Q $P(XUNAME,"^",9)
- ;
- SET8(XUPRO,XUIEN) ;set/addSPECIALTY CODE by IEN
- I $G(XUPRO)="" Q 0
- I $G(XUIEN)'=+$G(XUIEN) Q 0
- N FDA,FDAIEN
- S FDAIEN(1)=XUIEN
- S FDA(8932.1,"+1,",8)=XUPRO
- D UPDATE^DIE("","FDA","FDAIEN","ERR")
- Q 1
- XUPCF ;BT/BP-OAK Person Class File APIs; 2/4/2010
- +1 ;;8.0;KERNEL;**541**; July 10, 1995;Build 8
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified
- +3 ;;these APIs are for updating Person Class File and for Kernal Team only.
- +4 ;;
- +5 ;;REFERENCED BY: PROVIDER TYPE(B), PROVIDER TYPE(C), CLASSIFICATION(D),
- +6 ;; AREA OF SPECIALIZATION(E), VA CODE(F), X12 CODE(G)
- +7 ;;^USC(8932.1,D0,0)= (#.01) PROVIDER TYPE [1F] ^ (#1) CLASSIFICATION [2F] ^
- +8 ;; ==>(#2) AREA OF SPECIALIZATION [3F] ^ (#3) STATUS [4S] ^ (#4)
- +9 ;; ==>DATE INACTIVATED [5D] ^ (#5) VA CODE [6F] ^ (#6) X12 CODE
- +10 ;; ==>[7F] ^ (#7) reserved [8F] ^ (#8) SPECIALTY CODE [9F] ^
- +11 ;;^USC(8932.1,D0,11,0)=^8932.111^^ (#11) DEFINITION
- +12 ;;^USC(8932.1,D0,11,D1,0)= (#.01) DEFINITION [1W] ^
- +13 ;;^USC(8932.1,D0,90002)= ^ (#90002) INDIVIDUAL/NON [2S] ^
- +14 QUIT
- +15 ;
- GET(XUIEN) ;
- +1 IF $GET(XUIEN)'=+$GET(XUIEN)
- WRITE !,"Invalid IEN"
- QUIT
- +2 WRITE !,"PROVIDER TYPE",?24,": ",$$GET01(XUIEN)
- +3 WRITE !,"CLASSIFICATION",?24,": ",$$GET1(XUIEN)
- +4 WRITE !,"AREA OF SPECIALIZATION",?24,": ",$$GET2(XUIEN)
- +5 WRITE !,"STATUS",?24,": ",$$GET3(XUIEN)
- +6 WRITE !,"DATE INACTIVATED",?24,": ",$$GET4(XUIEN)
- +7 WRITE !,"VA CODE",?24,": ",$$GET5(XUIEN)
- +8 WRITE !,"X12 CODE",?24,": ",$$GET6(XUIEN)
- +9 WRITE !,"SPECIALTY CODE",?24,": ",$$GET8(XUIEN)
- +10 QUIT
- +11 ;
- SET(XUIEN,XUDATA) ;
- +1 IF $GET(XUIEN)'=+$GET(XUIEN)
- WRITE !,"Invalid IEN"
- QUIT
- +2 IF $GET(XUDATA)=""
- WRITE !,"Invalid data"
- QUIT
- +3 NEW XUDA01
- SET XUDA01=$PIECE(XUDATA,"^",1)
- SET XUDA01=$$SET01(XUDA01,XUIEN)
- +4 NEW XUDA1
- SET XUDA1=$PIECE(XUDATA,"^",2)
- SET XUDA1=$$SET1(XUDA01,XUIEN)
- +5 NEW XUDA2
- SET XUDA2=$PIECE(XUDATA,"^",3)
- SET XUDA2=$$SET2(XUDA2,XUIEN)
- +6 NEW XUDA3
- SET XUDA3=$PIECE(XUDATA,"^",4)
- SET XUDA3=$$SET3(XUDA3,XUIEN)
- +7 NEW XUDA4
- SET XUDA4=$PIECE(XUDATA,"^",5)
- SET XUDA4=$$SET4(XUDA4,XUIEN)
- +8 NEW XUDA5
- SET XUDA5=$PIECE(XUDATA,"^",6)
- SET XUDA5=$$SET5(XUDA5,XUIEN)
- +9 NEW XUDA6
- SET XUDA6=$PIECE(XUDATA,"^",7)
- SET XUDA6=$$SET6(XUDA6,XUIEN)
- +10 NEW XUDA8
- SET XUDA8=$PIECE(XUDATA,"^",8)
- SET XUDA8=$$SET8(XUDA8,XUIEN)
- +11 QUIT
- +12 ;
- GET01(XUIEN) ;get PROVIDER TYPE by IEN
- +1 NEW XUNAME
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 QUIT $PIECE(XUNAME,"^",1)
- +5 ;
- SET01(XUPRO,XUIEN) ;set/add a new PROVIDER TYPE by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",.01)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1
- +8 ;
- GET1(XUIEN) ;get CLASSIFICATION by IEN
- +1 NEW XUNAME
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 QUIT $PIECE(XUNAME,"^",2)
- +5 ;
- SET1(XUPRO,XUIEN) ;set/add CLASSIFICATION by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",1)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1
- +8 ;
- GET2(XUIEN) ;get AREA OF SPECIALIZATION by IEN
- +1 NEW XUNAME
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 QUIT $PIECE(XUNAME,"^",3)
- +5 ;
- SET2(XUPRO,XUIEN) ;set/add AREA OF SPECIALIZATION by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",2)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1
- +8 ;
- GET3(XUIEN) ;get STATUS by IEN
- +1 NEW XUNAME
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 IF $PIECE(XUNAME,"^",4)="a"
- QUIT "Active"
- +5 QUIT "Inactive"
- +6 ;
- SET3(XUPRO,XUIEN) ;set/add STATUS by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",3)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1
- +8 ;
- GET4(XUIEN) ;get DATE INACTIVATED by IEN
- +1 NEW XUNAME,XUDATE
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 SET XUDATE=$PIECE(XUNAME,"^",5)
- +5 QUIT $$FMTE^XLFDT(XUDATE)
- +6 ;
- SET4(XUPRO,XUIEN) ;set/add DATE INACTIVATED by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",4)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1
- +8 ;
- GET5(XUIEN) ;get VA CODE by IEN
- +1 NEW XUNAME
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 QUIT $PIECE(XUNAME,"^",6)
- +5 ;
- SET5(XUPRO,XUIEN) ;set/add VA CODE by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",5)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1
- +8 ;
- GET6(XUIEN) ;get X12 CODE by IEN
- +1 NEW XUNAME
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 QUIT $PIECE(XUNAME,"^",7)
- +5 ;
- SET6(XUPRO,XUIEN) ;set/add X12 CODE by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",6)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1
- +8 ;
- GET8(XUIEN) ;get SPECIALTY CODE by IEN
- +1 NEW XUNAME
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT "Invalid IEN"
- +3 SET XUNAME=$GET(^USC(8932.1,XUIEN,0))
- IF XUNAME=""
- QUIT "Invalid IEN"
- +4 QUIT $PIECE(XUNAME,"^",9)
- +5 ;
- SET8(XUPRO,XUIEN) ;set/addSPECIALTY CODE by IEN
- +1 IF $GET(XUPRO)=""
- QUIT 0
- +2 IF $GET(XUIEN)'=+$GET(XUIEN)
- QUIT 0
- +3 NEW FDA,FDAIEN
- +4 SET FDAIEN(1)=XUIEN
- +5 SET FDA(8932.1,"+1,",8)=XUPRO
- +6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
- +7 QUIT 1