AGTXRHRN.m

AGTXRHRN ; IHS/ASDS/EFG - utility for investigating valid Official Registration FAC:HRN ;  

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

 ;****************************************************************

 ;

 ;This is a utility for investigating Official Registration Fac:HRNs

 ;NEEDS DFN

 ;given AGRSITE it will test/return AGRHRN=0 OR = HRN if it is valid

 ;not given AGRSITE it will return an AGRSITE

 ;and AGRHRN =0 if none or with valid entries

 ;

 ;****************************************************************

 ;

 I $G(AGRSITE) D  G END

 . D HRN

 . S:'$D(^AGFAC("AC",AGRSITE)) AGRHRN=0

 S AGRSITE=0

 F  S AGRSITE=$O(^AGFAC("AC",AGRSITE)) Q:AGRSITE'>0  D HRN I $G(AGRHRN) G END ;--->

 G END

 ;****************************************************************

HRN ;EP -

 ;find valid HRN for AGRSITE,DFN

TSTHRN ;

 ;test HRN validity  uses AGRSITE returns AGRHRN if found and valid

 S AGRHRN=0

 Q:'$D(^AUPNPAT(DFN,41,AGRSITE,0))  ;no data

 S X=$P(^AUPNPAT(DFN,41,AGRSITE,0),U,2)

 S (DA,D1)=AGRSITE

 S (DA(1),D0)=DFN

 X $P(^DD(9000001.41,.02,0),U,5,99)

 K DA,D1,D0

 Q:'$G(X)  ;fails input test

 S AGRHRN=$P(^AUPNPAT(DFN,41,AGRSITE,0),"^",2)

 S AGRHRN("DT")=$P(^AUPNPAT(DFN,41,AGRSITE,0),U,3)

 S AGRHRN("S")=$P(^AUPNPAT(DFN,41,AGRSITE,0),U,5)

 I (AGRHRN'?1.6N)!(AGRHRN("S")="M") S AGRHRN=0 Q  ;fails pattern or merge

 I '$G(AGRHRN("DT")) Q  ;passes, NO DELETES,INACTIVE

 I AGRHRN("S")="I" Q  ;Inactivated records pass

 S AGRHRN=0 ;all deletes fail .. calling routine must handle error

 Q

 ;****************************************************************

END ;

 K AGRHRN("DT"),AGRHRN("S"),X,X1,X2

 Q

AGTXRHRN  ; IHS/ASDS/EFG - utility for investigating valid Official Registration FAC:HRN ;  

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

 +3       ;****************************************************************

 +4       ;

 +5       ;This is a utility for investigating Official Registration Fac:HRNs

 +6       ;NEEDS DFN

 +7       ;given AGRSITE it will test/return AGRHRN=0 OR = HRN if it is valid

 +8       ;not given AGRSITE it will return an AGRSITE

 +9       ;and AGRHRN =0 if none or with valid entries

 +10      ;

 +11      ;****************************************************************

 +12      ;

 +13       IF $GET(AGRSITE)

               Begin DoDot:1

 +14               DO HRN

 +15               IF '$DATA(^AGFAC("AC",AGRSITE))

                       SET AGRHRN=0

               End DoDot:1

               GOTO END

 +16       SET AGRSITE=0

 +17      ;--->

           FOR 

               SET AGRSITE=$ORDER(^AGFAC("AC",AGRSITE))

               IF AGRSITE'>0

                   QUIT 

               DO HRN

               IF $GET(AGRHRN)

                   GOTO END

 +18       GOTO END

 +19      ;****************************************************************

HRN       ;EP -

 +1       ;find valid HRN for AGRSITE,DFN

TSTHRN    ;

 +1       ;test HRN validity  uses AGRSITE returns AGRHRN if found and valid

 +2        SET AGRHRN=0

 +3       ;no data

           IF '$DATA(^AUPNPAT(DFN,41,AGRSITE,0))

               QUIT 

 +4        SET X=$PIECE(^AUPNPAT(DFN,41,AGRSITE,0),U,2)

 +5        SET (DA,D1)=AGRSITE

 +6        SET (DA(1),D0)=DFN

 +7        XECUTE $PIECE(^DD(9000001.41,.02,0),U,5,99)

 +8        KILL DA,D1,D0

 +9       ;fails input test

           IF '$GET(X)

               QUIT 

 +10       SET AGRHRN=$PIECE(^AUPNPAT(DFN,41,AGRSITE,0),"^",2)

 +11       SET AGRHRN("DT")=$PIECE(^AUPNPAT(DFN,41,AGRSITE,0),U,3)

 +12       SET AGRHRN("S")=$PIECE(^AUPNPAT(DFN,41,AGRSITE,0),U,5)

 +13      ;fails pattern or merge

           IF (AGRHRN'?1.6N)!(AGRHRN("S")="M")

               SET AGRHRN=0

               QUIT 

 +14      ;passes, NO DELETES,INACTIVE

           IF '$GET(AGRHRN("DT"))

               QUIT 

 +15      ;Inactivated records pass

           IF AGRHRN("S")="I"

               QUIT 

 +16      ;all deletes fail .. calling routine must handle error

           SET AGRHRN=0

 +17       QUIT 

 +18      ;****************************************************************

END       ;

 +1        KILL AGRHRN("DT"),AGRHRN("S"),X,X1,X2

 +2        QUIT