MDCVTU ; HOIFO/NCA - Medicine Conversion Verification Utility ; [08-28-2003 11:34]
;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
; Integration Agreement:
; IA #10155 Access 3rd piece of ^DD(filenumber,fieldnumber,0)
;
EN ; [Procedure] Verify the Medicine Records Are Converted
N CNT,CNTS,MDC,MDK,MDL,MDTIT
S MDTIT=";"_$P($G(^DD(703.92,.02,0)),U,3)
D EN1 W !!!
S MDK="" F S MDK=$O(MDC(MDK)) Q:MDK="" S MDX=$G(MDC(MDK)) D
.I +MDX S MDL=$F(MDTIT,";"_MDK_":") W !,$P($E(MDTIT,MDL,999),";")_": ",?30,+MDX
I '$D(MDC) W !,"Verified Medicine Reports Conversion Completed.",!
W !,"Reports Converted ",?30,CNT
W !,"Reports Skipped: ",?30,CNTS
Q
EN1 ; Loop to Check Medicine Records
N MDP,MDPTR,MDREC,MDS,MDX
S MDREC=$NA(^MCAR(690,"AC")),(CNT,CNTS)=0
F S MDREC=$Q(@MDREC) Q:MDREC="" Q:$QS(MDREC,2)'="AC" D
.S MDPTR=$QS(MDREC,6)_";"_$QS(MDREC,5)_","
.S MDP=$O(^MDD(703.9,1,2,"B",MDPTR,0))
.I 'MDP S MDS=$$STATUS^MDCVT(MDPTR) S:$G(MDC(MDS))="" MDC(MDS)=0 S MDC(MDS)=MDC(MDS)+1 Q
.S MDS=$P(^MDD(703.9,1,2,MDP,0),U,2)
.I MDS="CR" S CNT=CNT+1 Q
.I MDS="S" S CNTS=CNTS+1 Q
.S:$G(MDC(MDS))="" MDC(MDS)=0 S MDC(MDS)=MDC(MDS)+1
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCVTU 1178 printed Nov 22, 2024@16:52:52 Page 2
MDCVTU ; HOIFO/NCA - Medicine Conversion Verification Utility ; [08-28-2003 11:34]
+1 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
+2 ; Integration Agreement:
+3 ; IA #10155 Access 3rd piece of ^DD(filenumber,fieldnumber,0)
+4 ;
EN ; [Procedure] Verify the Medicine Records Are Converted
+1 NEW CNT,CNTS,MDC,MDK,MDL,MDTIT
+2 SET MDTIT=";"_$PIECE($GET(^DD(703.92,.02,0)),U,3)
+3 DO EN1
WRITE !!!
+4 SET MDK=""
FOR
SET MDK=$ORDER(MDC(MDK))
if MDK=""
QUIT
SET MDX=$GET(MDC(MDK))
Begin DoDot:1
+5 IF +MDX
SET MDL=$FIND(MDTIT,";"_MDK_":")
WRITE !,$PIECE($EXTRACT(MDTIT,MDL,999),";")_": ",?30,+MDX
End DoDot:1
+6 IF '$DATA(MDC)
WRITE !,"Verified Medicine Reports Conversion Completed.",!
+7 WRITE !,"Reports Converted ",?30,CNT
+8 WRITE !,"Reports Skipped: ",?30,CNTS
+9 QUIT
EN1 ; Loop to Check Medicine Records
+1 NEW MDP,MDPTR,MDREC,MDS,MDX
+2 SET MDREC=$NAME(^MCAR(690,"AC"))
SET (CNT,CNTS)=0
+3 FOR
SET MDREC=$QUERY(@MDREC)
if MDREC=""
QUIT
if $QSUBSCRIPT(MDREC,2)'="AC"
QUIT
Begin DoDot:1
+4 SET MDPTR=$QSUBSCRIPT(MDREC,6)_";"_$QSUBSCRIPT(MDREC,5)_","
+5 SET MDP=$ORDER(^MDD(703.9,1,2,"B",MDPTR,0))
+6 IF 'MDP
SET MDS=$$STATUS^MDCVT(MDPTR)
if $GET(MDC(MDS))=""
SET MDC(MDS)=0
SET MDC(MDS)=MDC(MDS)+1
QUIT
+7 SET MDS=$PIECE(^MDD(703.9,1,2,MDP,0),U,2)
+8 IF MDS="CR"
SET CNT=CNT+1
QUIT
+9 IF MDS="S"
SET CNTS=CNTS+1
QUIT
+10 if $GET(MDC(MDS))=""
SET MDC(MDS)=0
SET MDC(MDS)=MDC(MDS)+1
+11 QUIT
End DoDot:1
+12 QUIT
