Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBCPNCS

DVBCPNCS.m

Go to the documentation of this file.
DVBCPNCS ;ALB/BG;PNCS DBQ UTILITY RPC ; 5/7/21 8:48am
 ;;2.7;AMIE;**226**;Apr 10, 1995;Build 18
 ;Per VHA Directive 6402 this routine should not be modified
 ;
 Q
 ;
ACTIVE(DVBRTN) ;
 N DVBIEN,DVBCTR,DVBNM,DVBPROD,DVBVER,DVBPNFL
 S DVBCTR=0
 S DVBIEN=0 F  S DVBIEN=$O(^DVB(396.18,DVBIEN)) Q:'DVBIEN  D
 .Q:$P($G(^DVB(396.18,DVBIEN,4)),U,1)=9
 .Q:$P($G(^DVB(396.18,DVBIEN,2)),U,2)'=""
 .Q:$P($G(^DVB(396.18,DVBIEN,2)),U,1)=""
 .S DVBCTR=DVBCTR+1
 .S DVBNM=$P($P($G(^DVB(396.18,DVBIEN,0)),U,1),"~",1)
 .S DVBPROD=$$FMTE^XLFDT($P($G(^DVB(396.18,DVBIEN,2)),U))
 .S DVBVER=$P($G(^DVB(396.18,DVBIEN,0)),"~",2)
 .S DVBPNFL=$P($G(^DVB(396.18,DVBIEN,3,1,0))," ",3)
 .S DVBRTN(DVBCTR)=$G(DVBNM)_"^"_$G(DVBPROD)_"^"_$G(DVBVER)_"^"_$G(DVBPNFL)
 Q
 ;
DBQCHECK(DVBRTN,DVBIEN) ;
 N DVBDBQ,DVBCTR,DVBCT,DVBSTAT
 S DVBCTR=0
 I $G(DVBIEN)="" S DVBRTN="FALSE" Q
 S DVBCT=0 F  S DVBCT=$O(^DVB(396.17,$G(DVBIEN),1,DVBCT)) Q:'DVBCT  D
 .S DVBCTR=DVBCTR+1
 .S DVBDBQ=$P(^DVB(396.17,$G(DVBIEN),1,DVBCT,0),U)
 .S DVBSTAT=$S($P($G(^DVB(396.18,DVBDBQ,2)),U,2)="":"TRUE",1:"FALSE")
 .I DVBSTAT="FALSE" S DIE="^DVB(396.17,",DR="11///O",DA=DVBIEN D ^DIE
 .S DVBRTN(DVBCTR)=$G(DVBSTAT)_"^"_$P(^DVB(396.17,$G(DVBIEN),1,DVBCT,0),U,2)
 Q
 ;
DBQSTAT(DVBRTN,DVBIEN,DVBSTAT) ;
 I $G(DVBIEN)="" S DVBRTN="-1" Q
 I $G(DVBSTAT)="" S DVBRTN="-1" Q
 S $P(^DVB(396.17,DVBIEN,5),U,2)=DVBSTAT
 S DVBRTN="1"
 Q
 ;
DBQCK(DVBRTN,DVBDBQ,DVBDATE) ;
 N DVBDDIFF,DVBDACT,DVBFLAG,DVBDT,DVBIEN,DVBYR,DVBACDT,DVBDIFF,DVBCNT,DVBNM
 I '$D(DVBDBQ) Q
 I '$D(DVBDATE) Q
 S DVBFLAG=0,DVBCNT=0
 S DVBDATE=$TR($E($P(DVBDATE,"T"),1,100),"-") S DVBYR=$E(DVBDATE,1,4)-1700
 S DVBDATE=DVBYR_$E(DVBDATE,5,100)
 S DVBDBQ=$TR(DVBDBQ,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 S DVBIEN=0 F  S DVBIEN=$O(^DVB(396.18,DVBIEN)) Q:'DVBIEN  D
 .N DVBDIFF,DVBDDIFF,DVBDACT,DVBDACT
 .S DVBNM=$P($P($G(^DVB(396.18,DVBIEN,0)),U,1),"~",1)
 .I DVBNM'[DVBDBQ Q
 .S DVBDACT=$P($G(^DVB(396.18,DVBIEN,2)),U,2)
 .S DVBACDT=$P($G(^DVB(396.18,DVBIEN,2)),U)
 .S DVBDIFF=$$FMDIFF^XLFDT(DVBDATE,DVBACDT)
 .I DVBDACT'="" S DVBDDIFF=$$FMDIFF^XLFDT(DVBDATE,DVBDACT)
 .I DVBDACT="",DVBDIFF'["-" S DVBRTN="TRUE" Q
 .I DVBDIFF["-" S DVBRTN="FALSE" Q
 .I DVBDACT'="" S DVBRTN="FALSE" Q
 Q