- PSORMRXD ;BIRM/JAM - REMOTE DATA INTEROPERABILITY UTILITY ; 10/29/08
- ;;7.0;OUTPATIENT PHARMACY;**320**;DEC 1997;Build 2
- ;;
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN(PSOSEL) ;- ListManager entry point
- ;
- D EN^VALM("PSO RDI VISITS DETAIL")
- D FULL^VALM1
- G EXIT
- ;
- HDR ; Patient Header for remote site
- D HDR^PSORMRX
- I PSOSEL="DO" S VALM("TITLE")="Medication Profile - Remote"
- I PSOSEL="DB" S VALM("TITLE")="Medication Profile - Both"
- Q
- ;
- INIT ; - Populates the Body section for ListMan
- S VALMCNT=0
- D DETAIL
- S VALMSG="Enter ?? for more actions"
- Q
- ;
- DETAIL ; Build prescription details for local site
- N SEQ,ST,DRG,DATA,NODE0,NODE1,PSOX,ISDT,QTY,LFDT,PSOSD,PSODTCUT,LINE,RX
- N FSIG,PRVDR,SIG,STA,LC,CNT
- ; - get the last sequence number for remote prescriptions
- S SEQ=$O(^TMP("PSORDI",$J,"A"),-1)
- I PSOSEL="DO" S VALMCNT=$S(SEQ:SEQ,1:1) D Q
- .; if no remote sites, set display reasons if available
- .I '+$O(^TMP("PSORDI",$J,0)),$D(^TMP($J,"PSORDI",1)) S LC="",CNT=0 D
- ..F S LC=$O(^TMP($J,"PSORDI",LC)) Q:LC="" D
- ...S CNT=CNT+1,^TMP("PSORDI",$J,CNT,0)=" "_$G(^TMP($J,"PSORDI",LC,0))
- ; get local prescriptions
- S PSODTCUT=$$FMADD^XLFDT(DT,-90)
- D ^PSOBUILD
- I +SEQ<1 S SEQ=0
- I SEQ>1 S LINE="" D SETTMP
- I $D(PSOSD) D
- .S LINE="LOCAL PRESCRIPTIONS" D SETTMP
- S (LINE,ST)=""
- F S ST=$O(PSOSD(ST)) Q:ST="" D
- .S (LINE,DRG)="" F S DRG=$O(PSOSD(ST,DRG)) Q:DRG="" D
- ..S DATA=PSOSD(ST,DRG)
- ..S NODE0=$G(^PSRX(+$P(DATA,"^"),0)),LFDT=+$G(^(3)) I NODE0="" Q
- ..S STA=$$STACHK^PSORMRX(ST,$P($G(^PSRX(+$P(DATA,"^"),2)),"^",6))
- ..I '+STA Q
- ..S STA=$P(STA,"^",2)
- ..S LINE=$P(NODE0,"^"),$E(LINE,15)=$E(DRG,1,34)
- ..S $E(LINE,50)=$S(STA="DISCONTINUED":"DC",1:$E(STA))
- ..S QTY=$P(NODE0,"^",7),ISDT=$P(NODE0,"^",13)
- ..S $E(LINE,53)=$J(+QTY,4),$E(LINE,60)=$$FMTE^XLFDT(ISDT,"2ZM")
- ..F PSOX=0:0 S PSOX=$O(^PSRX(+$P(DATA,"^"),1,PSOX)) Q:'PSOX D
- ...S NODE1=$G(^PSRX(+$P(DATA,"^"),1,PSOX,0))
- ...I +NODE1=LFDT,$P(NODE1,"^",16) S LFDT=LFDT_"^R"
- ..I '$O(^PSRX(+$P(DATA,"^"),1,0)),$P($G(^PSRX(+$P(DATA,"^"),2)),"^",15) D
- ...S LFDT=LFDT_"^R"
- ..S $E(LINE,70)=$$FMTE^XLFDT(LFDT,"2ZM")
- ..D SETTMP
- ..K FSIG D GETSIG
- ..S LINE="",$E(LINE,15)="SIG: ",SIG=0
- ..F S SIG=$O(FSIG(SIG)) Q:'SIG D
- ...S $E(LINE,20)=FSIG(SIG) D SETTMP S LINE=""
- ..I $O(FSIG(""))="" D SETTMP
- ..S PRVDR=$P($G(^PSRX(+$P(DATA,"^"),0)),"^",4),LINE=""
- ..S $E(LINE,15)="PROVIDER: "_$$UP^XLFSTR($$NAME^XUSER(PRVDR,"F"))
- ..D SETTMP S LINE=""
- S VALMCNT=SEQ
- Q
- ;
- SETTMP ;Sets the ^TMP("PSORDI",$J global
- S SEQ=SEQ+1,^TMP("PSORDI",$J,SEQ,0)=LINE
- Q
- ;
- GETSIG ;Gets SIG from File #52, format and place into FSIG array
- N I,RSIG
- S I=0 F S I=$O(^PSRX(+$P(DATA,"^"),"SIG1",I)) Q:'I D
- .S RSIG(I)=$G(^PSRX(+$P(DATA,"^"),"SIG1",I,0))
- I $O(RSIG(""))'="" D FMTSIG^PSORMRX
- Q
- ;
- HELP ;
- Q
- ;
- EXIT ;
- ;Remove local but leave remote prescriptions
- N CNT,SEQ
- I '$D(PSORFLG) D Q
- .K ^TMP("PSORDI",$J),^TMP($J,"PSORDI"),^TMP("PSORDIS",$J)
- S SEQ=$G(^TMP("PSORDI",$J,"REMOTE COUNT"))
- F S SEQ=$O(^TMP("PSORDI",$J,SEQ)) Q:'SEQ K ^TMP("PSORDI",$J,SEQ)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORMRXD 3147 printed Feb 19, 2025@00:00:29 Page 2
- PSORMRXD ;BIRM/JAM - REMOTE DATA INTEROPERABILITY UTILITY ; 10/29/08
- +1 ;;7.0;OUTPATIENT PHARMACY;**320**;DEC 1997;Build 2
- +2 ;;
- +3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +4 ;
- EN(PSOSEL) ;- ListManager entry point
- +1 ;
- +2 DO EN^VALM("PSO RDI VISITS DETAIL")
- +3 DO FULL^VALM1
- +4 GOTO EXIT
- +5 ;
- HDR ; Patient Header for remote site
- +1 DO HDR^PSORMRX
- +2 IF PSOSEL="DO"
- SET VALM("TITLE")="Medication Profile - Remote"
- +3 IF PSOSEL="DB"
- SET VALM("TITLE")="Medication Profile - Both"
- +4 QUIT
- +5 ;
- INIT ; - Populates the Body section for ListMan
- +1 SET VALMCNT=0
- +2 DO DETAIL
- +3 SET VALMSG="Enter ?? for more actions"
- +4 QUIT
- +5 ;
- DETAIL ; Build prescription details for local site
- +1 NEW SEQ,ST,DRG,DATA,NODE0,NODE1,PSOX,ISDT,QTY,LFDT,PSOSD,PSODTCUT,LINE,RX
- +2 NEW FSIG,PRVDR,SIG,STA,LC,CNT
- +3 ; - get the last sequence number for remote prescriptions
- +4 SET SEQ=$ORDER(^TMP("PSORDI",$JOB,"A"),-1)
- +5 IF PSOSEL="DO"
- SET VALMCNT=$SELECT(SEQ:SEQ,1:1)
- Begin DoDot:1
- +6 ; if no remote sites, set display reasons if available
- +7 IF '+$ORDER(^TMP("PSORDI",$JOB,0))
- IF $DATA(^TMP($JOB,"PSORDI",1))
- SET LC=""
- SET CNT=0
- Begin DoDot:2
- +8 FOR
- SET LC=$ORDER(^TMP($JOB,"PSORDI",LC))
- if LC=""
- QUIT
- Begin DoDot:3
- +9 SET CNT=CNT+1
- SET ^TMP("PSORDI",$JOB,CNT,0)=" "_$GET(^TMP($JOB,"PSORDI",LC,0))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +10 ; get local prescriptions
- +11 SET PSODTCUT=$$FMADD^XLFDT(DT,-90)
- +12 DO ^PSOBUILD
- +13 IF +SEQ<1
- SET SEQ=0
- +14 IF SEQ>1
- SET LINE=""
- DO SETTMP
- +15 IF $DATA(PSOSD)
- Begin DoDot:1
- +16 SET LINE="LOCAL PRESCRIPTIONS"
- DO SETTMP
- End DoDot:1
- +17 SET (LINE,ST)=""
- +18 FOR
- SET ST=$ORDER(PSOSD(ST))
- if ST=""
- QUIT
- Begin DoDot:1
- +19 SET (LINE,DRG)=""
- FOR
- SET DRG=$ORDER(PSOSD(ST,DRG))
- if DRG=""
- QUIT
- Begin DoDot:2
- +20 SET DATA=PSOSD(ST,DRG)
- +21 SET NODE0=$GET(^PSRX(+$PIECE(DATA,"^"),0))
- SET LFDT=+$GET(^(3))
- IF NODE0=""
- QUIT
- +22 SET STA=$$STACHK^PSORMRX(ST,$PIECE($GET(^PSRX(+$PIECE(DATA,"^"),2)),"^",6))
- +23 IF '+STA
- QUIT
- +24 SET STA=$PIECE(STA,"^",2)
- +25 SET LINE=$PIECE(NODE0,"^")
- SET $EXTRACT(LINE,15)=$EXTRACT(DRG,1,34)
- +26 SET $EXTRACT(LINE,50)=$SELECT(STA="DISCONTINUED":"DC",1:$EXTRACT(STA))
- +27 SET QTY=$PIECE(NODE0,"^",7)
- SET ISDT=$PIECE(NODE0,"^",13)
- +28 SET $EXTRACT(LINE,53)=$JUSTIFY(+QTY,4)
- SET $EXTRACT(LINE,60)=$$FMTE^XLFDT(ISDT,"2ZM")
- +29 FOR PSOX=0:0
- SET PSOX=$ORDER(^PSRX(+$PIECE(DATA,"^"),1,PSOX))
- if 'PSOX
- QUIT
- Begin DoDot:3
- +30 SET NODE1=$GET(^PSRX(+$PIECE(DATA,"^"),1,PSOX,0))
- +31 IF +NODE1=LFDT
- IF $PIECE(NODE1,"^",16)
- SET LFDT=LFDT_"^R"
- End DoDot:3
- +32 IF '$ORDER(^PSRX(+$PIECE(DATA,"^"),1,0))
- IF $PIECE($GET(^PSRX(+$PIECE(DATA,"^"),2)),"^",15)
- Begin DoDot:3
- +33 SET LFDT=LFDT_"^R"
- End DoDot:3
- +34 SET $EXTRACT(LINE,70)=$$FMTE^XLFDT(LFDT,"2ZM")
- +35 DO SETTMP
- +36 KILL FSIG
- DO GETSIG
- +37 SET LINE=""
- SET $EXTRACT(LINE,15)="SIG: "
- SET SIG=0
- +38 FOR
- SET SIG=$ORDER(FSIG(SIG))
- if 'SIG
- QUIT
- Begin DoDot:3
- +39 SET $EXTRACT(LINE,20)=FSIG(SIG)
- DO SETTMP
- SET LINE=""
- End DoDot:3
- +40 IF $ORDER(FSIG(""))=""
- DO SETTMP
- +41 SET PRVDR=$PIECE($GET(^PSRX(+$PIECE(DATA,"^"),0)),"^",4)
- SET LINE=""
- +42 SET $EXTRACT(LINE,15)="PROVIDER: "_$$UP^XLFSTR($$NAME^XUSER(PRVDR,"F"))
- +43 DO SETTMP
- SET LINE=""
- End DoDot:2
- End DoDot:1
- +44 SET VALMCNT=SEQ
- +45 QUIT
- +46 ;
- SETTMP ;Sets the ^TMP("PSORDI",$J global
- +1 SET SEQ=SEQ+1
- SET ^TMP("PSORDI",$JOB,SEQ,0)=LINE
- +2 QUIT
- +3 ;
- GETSIG ;Gets SIG from File #52, format and place into FSIG array
- +1 NEW I,RSIG
- +2 SET I=0
- FOR
- SET I=$ORDER(^PSRX(+$PIECE(DATA,"^"),"SIG1",I))
- if 'I
- QUIT
- Begin DoDot:1
- +3 SET RSIG(I)=$GET(^PSRX(+$PIECE(DATA,"^"),"SIG1",I,0))
- End DoDot:1
- +4 IF $ORDER(RSIG(""))'=""
- DO FMTSIG^PSORMRX
- +5 QUIT
- +6 ;
- HELP ;
- +1 QUIT
- +2 ;
- EXIT ;
- +1 ;Remove local but leave remote prescriptions
- +2 NEW CNT,SEQ
- +3 IF '$DATA(PSORFLG)
- Begin DoDot:1
- +4 KILL ^TMP("PSORDI",$JOB),^TMP($JOB,"PSORDI"),^TMP("PSORDIS",$JOB)
- End DoDot:1
- QUIT
- +5 SET SEQ=$GET(^TMP("PSORDI",$JOB,"REMOTE COUNT"))
- +6 FOR
- SET SEQ=$ORDER(^TMP("PSORDI",$JOB,SEQ))
- if 'SEQ
- QUIT
- KILL ^TMP("PSORDI",$JOB,SEQ)
- +7 QUIT